+++ /dev/null
- module compare
-!-----------------------------------------------------------------------------
- use io_units
- use names
- use geometry_data
- use energy_data
- use control_data
-#if .not. defined WHAM_RUN && .not. defined CLUSTER
- use compare_data
- use io_base
- use io_config
- use geometry
- use energy
- use control, only: hpb_partition
- use minim_data
- use minimm, only: sc_move, minimize
-#endif
- implicit none
-!-----------------------------------------------------------------------------
-!
-!
-!-----------------------------------------------------------------------------
- contains
-#if .not. defined WHAM_RUN && .not. defined CLUSTER
-!-----------------------------------------------------------------------------
-! contact.f
-!-----------------------------------------------------------------------------
- subroutine contact(lprint,ncont,icont,co)
-
- use geometry, only:dist
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.INTERACT'
-! include 'COMMON.FFIELD'
-! include 'COMMON.NAMES'
- real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
- integer :: ncont
- integer,dimension(2,12*nres) :: icont!(2,12*nres) !(2,maxcont) (maxcont=12*maxres)
- logical :: lprint
-!el local variables
- real(kind=8) :: co,rcomp
- integer :: kkk,i,j,i1,i2,it1,it2,iti,itj
-
- ncont=0
- kkk=3
- do i=nnt+kkk,nct
- iti=iabs(itype(i))
- do j=nnt,i-kkk
- itj=iabs(itype(j))
- if (ipot.ne.4) then
-! rcomp=sigmaii(iti,itj)+1.0D0
- rcomp=facont*sigmaii(iti,itj)
- else
-! rcomp=sigma(iti,itj)+1.0D0
- rcomp=facont*sigma(iti,itj)
- endif
-! rcomp=6.5D0
-! print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j)
- if (dist(nres+i,nres+j).lt.rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,'(a)') 'Contact map:'
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4)') &
- i,restyp(it1),i1,restyp(it2),i2
- enddo
- endif
- co = 0.0d0
- do i=1,ncont
- co = co + dfloat(iabs(icont(1,i)-icont(2,i)))
- enddo
- co = co / (nres*ncont)
- return
- end subroutine contact
-!-----------------------------------------------------------------------------
- real(kind=8) function contact_fract(ncont,ncont_ref,icont,icont_ref)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
- integer :: ncont,ncont_ref
- integer,dimension(2,12*nres) :: icont,icont_ref !(2,12*nres) (2,maxcont) (maxcont=12*maxres)
-!el local variables
- integer :: i,j,nmatch
- nmatch=0
-! print *,'ncont=',ncont,' ncont_ref=',ncont_ref
-! write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
-! write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
-! write (iout,'(20i4)') (icont(1,i),i=1,ncont)
-! write (iout,'(20i4)') (icont(2,i),i=1,ncont)
- do i=1,ncont
- do j=1,ncont_ref
- if (icont(1,i).eq.icont_ref(1,j) .and. &
- icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
- enddo
- enddo
-! print *,' nmatch=',nmatch
-! contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
- contact_fract=dfloat(nmatch)/dfloat(ncont_ref)
- return
- end function contact_fract
-!-----------------------------------------------------------------------------
- real(kind=8) function contact_fract_nn(ncont,ncont_ref,icont,icont_ref)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
- integer :: ncont,ncont_ref
- integer,dimension(2,12*nres) :: icont,icont_ref !(2,12*nres) (2,maxcont) (maxcont=12*maxres)
-!el local variables
- integer :: i,j,nmatch
- nmatch=0
-! print *,'ncont=',ncont,' ncont_ref=',ncont_ref
-! write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref)
-! write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref)
-! write (iout,'(20i4)') (icont(1,i),i=1,ncont)
-! write (iout,'(20i4)') (icont(2,i),i=1,ncont)
- do i=1,ncont
- do j=1,ncont_ref
- if (icont(1,i).eq.icont_ref(1,j) .and. &
- icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1
- enddo
- enddo
-! print *,' nmatch=',nmatch
-! contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref))
- contact_fract_nn=dfloat(ncont-nmatch)/dfloat(ncont)
- return
- end function contact_fract_nn
-!-----------------------------------------------------------------------------
- subroutine hairpin(lprint,nharp,iharp)
-
- use geometry, only:dist
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.INTERACT'
-! include 'COMMON.FFIELD'
-! include 'COMMON.NAMES'
- integer :: ncont
- integer,dimension(2,12*nres) :: icont !(2,maxcont) (maxcont=12*maxres)
- integer :: nharp
- integer,dimension(4,nres/3) :: iharp !(4,nres/3)(4,maxres/3)
- logical :: lprint,not_done
- real(kind=8) :: rcomp=6.0d0
-!el local variables
- integer :: i,j,kkk,k,i1,i2,it1,it2,j1,ii1,jj1
-! allocate(icont(2,12*nres))
-
- ncont=0
- kkk=0
-! print *,'nnt=',nnt,' nct=',nct
- do i=nnt,nct-3
- do k=1,3
- c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1))
- enddo
- do j=i+2,nct-1
- do k=1,3
- c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1))
- enddo
- if (dist(2*nres+1,2*nres+2).lt.rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,'(a)') 'PP contact map:'
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4)') &
- i,restyp(it1),i1,restyp(it2),i2
- enddo
- endif
-! finding hairpins
- nharp=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then
-! write (iout,*) "found turn at ",i1,j1
- ii1=i1
- jj1=j1
- not_done=.true.
- do while (not_done)
- i1=i1-1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
-! write (iout,*) i1,j1,not_done
- enddo
- i1=i1+1
- j1=j1-1
- if (j1-i1.gt.4) then
- nharp=nharp+1
- iharp(1,nharp)=i1
- iharp(2,nharp)=j1
- iharp(3,nharp)=ii1
- iharp(4,nharp)=jj1
-! write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4)
- endif
- endif
- enddo
-! do i=1,nharp
-! write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4)
-! enddo
- if (lprint) then
- write (iout,*) "Hairpins:"
- do i=1,nharp
- i1=iharp(1,i)
- j1=iharp(2,i)
- ii1=iharp(3,i)
- jj1=iharp(4,i)
- write (iout,*)
- write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1)
- write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1)
-! do k=jj1,j1,-1
-! write (iout,'(a,i3,$)') restyp(itype(k)),k
-! enddo
- enddo
- endif
- return
- end subroutine hairpin
-!-----------------------------------------------------------------------------
-! elecont.f
-!-----------------------------------------------------------------------------
- subroutine elecont(lprint,ncont,icont)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.INTERACT'
-! include 'COMMON.LOCAL'
-! include 'COMMON.FFIELD'
-! include 'COMMON.NAMES'
- logical :: lprint
- real(kind=8),dimension(2,2) :: elpp_6,elpp_3,ael6_,ael3_
- real(kind=8) :: ael6_i,ael3_i
- real(kind=8),dimension(2,2) :: app_,bpp_,rpp_
- integer :: ncont
- integer,dimension(2,12*nres) :: icont !(2,12*nres)(2,maxcont) (maxcont=12*maxres)
- real(kind=8),dimension(12*nres) :: econt !(maxcont)
-!el local variables
- integer :: i,j,k,iteli,itelj,i1,i2,it1,it2,ic1,ic2
- real(kind=8) :: elcutoff,elecutoff_14,rri,ees,evdw
- real(kind=8) :: xi,yi,zi,dxi,dyi,dzi,aaa,bbb
- real(kind=8) :: xmedi,ymedi,zmedi
- real(kind=8) :: xj,yj,zj,dxj,dyj,dzj,rrmij,rmij,r3ij,r6ij
- real(kind=8) :: vrmij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
- evdwij,el1,el2,eesij,ene
-!
-! Load the constants of peptide bond - peptide bond interactions.
-! Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g.
-! proline) - determined by averaging ECEPP energy.
-!
-! as of 7/06/91.
-!
-! data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/
- data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/
- data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/
- data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/
-
-!el allocate(econt(12*nres)) !(maxcont)
-
- elcutoff = -0.3d0
- elecutoff_14 = -0.5d0
- if (lprint) write (iout,'(a)') &
- "Constants of electrostatic interaction energy expression."
- do i=1,2
- do j=1,2
- rri=rpp_(i,j)**6
- app_(i,j)=epp(i,j)*rri*rri
- bpp_(i,j)=-2.0*epp(i,j)*rri
- ael6_(i,j)=elpp_6(i,j)*4.2**6
- ael3_(i,j)=elpp_3(i,j)*4.2**3
- if (lprint) &
- write (iout,'(2i2,4e15.4)') i,j,app_(i,j),bpp_(i,j),ael6_(i,j),&
- ael3_(i,j)
- enddo
- enddo
- ncont=0
- ees=0.0
- evdw=0.0
- do 1 i=nnt,nct-2
- if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) goto 1
- xi=c(1,i)
- yi=c(2,i)
- zi=c(3,i)
- dxi=c(1,i+1)-c(1,i)
- dyi=c(2,i+1)-c(2,i)
- dzi=c(3,i+1)-c(3,i)
- xmedi=xi+0.5*dxi
- ymedi=yi+0.5*dyi
- zmedi=zi+0.5*dzi
- do 4 j=i+2,nct-1
- if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) goto 4
- iteli=itel(i)
- itelj=itel(j)
- if (j.eq.i+2 .and. itelj.eq.2) iteli=2
- if (iteli.eq.2 .and. itelj.eq.2) goto 4
- aaa=app_(iteli,itelj)
- bbb=bpp_(iteli,itelj)
- ael6_i=ael6_(iteli,itelj)
- ael3_i=ael3_(iteli,itelj)
- dxj=c(1,j+1)-c(1,j)
- dyj=c(2,j+1)-c(2,j)
- dzj=c(3,j+1)-c(3,j)
- xj=c(1,j)+0.5*dxj-xmedi
- yj=c(2,j)+0.5*dyj-ymedi
- zj=c(3,j)+0.5*dzj-zmedi
- rrmij=1.0/(xj*xj+yj*yj+zj*zj)
- rmij=sqrt(rrmij)
- r3ij=rrmij*rmij
- r6ij=r3ij*r3ij
- vrmij=vblinv*rmij
- cosa=(dxi*dxj+dyi*dyj+dzi*dzj)*vblinv2
- cosb=(xj*dxi+yj*dyi+zj*dzi)*vrmij
- cosg=(xj*dxj+yj*dyj+zj*dzj)*vrmij
- fac=cosa-3.0*cosb*cosg
- ev1=aaa*r6ij*r6ij
- ev2=bbb*r6ij
- fac3=ael6_i*r6ij
- fac4=ael3_i*r3ij
- evdwij=ev1+ev2
- el1=fac3*(4.0+fac*fac-3.0*(cosb*cosb+cosg*cosg))
- el2=fac4*fac
- eesij=el1+el2
- if (j.gt.i+2 .and. eesij.le.elcutoff .or. &
- j.eq.i+2 .and. eesij.le.elecutoff_14) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- econt(ncont)=eesij
- endif
- ees=ees+eesij
- evdw=evdw+evdwij
- 4 continue
- 1 continue
- if (lprint) then
- write (iout,*) 'Total average electrostatic energy: ',ees
- write (iout,*) 'VDW energy between peptide-group centers: ',evdw
- write (iout,*)
- write (iout,*) 'Electrostatic contacts before pruning: '
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') &
- i,restyp(it1),i1,restyp(it2),i2,econt(i)
- enddo
- endif
-! For given residues keep only the contacts with the greatest energy.
- i=0
- do while (i.lt.ncont)
- i=i+1
- ene=econt(i)
- ic1=icont(1,i)
- ic2=icont(2,i)
- j=i
- do while (j.lt.ncont)
- j=j+1
- if (ic1.eq.icont(1,j).and.iabs(icont(2,j)-ic2).le.2 .or. &
- ic2.eq.icont(2,j).and.iabs(icont(1,j)-ic1).le.2) then
-! write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2,
-! & " jc1",icont(1,j)," jc2",icont(2,j)," ncont",ncont
- if (econt(j).lt.ene .and. icont(2,j).ne.icont(1,j)+2) then
- if (ic1.eq.icont(1,j)) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.icont(2,j) &
- .and. iabs(icont(1,k)-ic1).le.2 .and. &
- econt(k).lt.econt(j) ) goto 21
- enddo
- else if (ic2.eq.icont(2,j) ) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.icont(1,j) &
- .and. iabs(icont(2,k)-ic2).le.2 .and. &
- econt(k).lt.econt(j) ) goto 21
- enddo
- endif
-! Remove ith contact
- do k=i+1,ncont
- icont(1,k-1)=icont(1,k)
- icont(2,k-1)=icont(2,k)
- econt(k-1)=econt(k)
- enddo
- i=i-1
- ncont=ncont-1
-! write (iout,*) "ncont",ncont
-! do k=1,ncont
-! write (iout,*) icont(1,k),icont(2,k)
-! enddo
- goto 20
- else if (econt(j).gt.ene .and. ic2.ne.ic1+2) &
- then
- if (ic1.eq.icont(1,j)) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.ic2 &
- .and. iabs(icont(1,k)-icont(1,j)).le.2 .and. &
- econt(k).lt.econt(i) ) goto 21
- enddo
- else if (ic2.eq.icont(2,j) ) then
- do k=1,ncont
- if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.ic1 &
- .and. iabs(icont(2,k)-icont(2,j)).le.2 .and. &
- econt(k).lt.econt(i) ) goto 21
- enddo
- endif
-! Remove jth contact
- do k=j+1,ncont
- icont(1,k-1)=icont(1,k)
- icont(2,k-1)=icont(2,k)
- econt(k-1)=econt(k)
- enddo
- ncont=ncont-1
-! write (iout,*) "ncont",ncont
-! do k=1,ncont
-! write (iout,*) icont(1,k),icont(2,k)
-! enddo
- j=j-1
- endif
- endif
- 21 continue
- enddo
- 20 continue
- enddo
- if (lprint) then
- write (iout,*)
- write (iout,*) 'Electrostatic contacts after pruning: '
- do i=1,ncont
- i1=icont(1,i)
- i2=icont(2,i)
- it1=itype(i1)
- it2=itype(i2)
- write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') &
- i,restyp(it1),i1,restyp(it2),i2,econt(i)
- enddo
- endif
- return
- end subroutine elecont
-!-----------------------------------------------------------------------------
- subroutine secondary2(lprint)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.VAR'
-! include 'COMMON.GEO'
-! include 'COMMON.CONTROL'
- integer :: ncont,i,j,i1,j1,nbeta,nstrand,ii1,jj1,ij,nhelix,&
- iii1,jjj1
- integer,dimension(2,12*nres) :: icont !(2,maxcont) (maxcont=12*maxres)
- integer,dimension(nres,4) :: isec !(maxres,4)
- integer,dimension(nres) :: nsec !(maxres)
- logical :: lprint,not_done !,freeres
- real(kind=8) :: p1,p2
-!el external freeres
-
-!el allocate(icont(2,12*nres),isec(nres,4),nsec(nres))
-
- if(.not.dccart) call chainbuild
- if(.not.allocated(hfrag)) allocate(hfrag(2,nres/3)) !(2,maxres/3)
-!d call write_pdb(99,'sec structure',0d0)
- ncont=0
- nbfrag=0
- nhfrag=0
- do i=1,nres
- isec(i,1)=0
- isec(i,2)=0
- nsec(i)=0
- enddo
-
- call elecont(lprint,ncont,icont)
-
-! finding parallel beta
-!d write (iout,*) '------- looking for parallel beta -----------'
- nbeta=0
- nstrand=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then
- ii1=i1
- jj1=j1
-!d write (iout,*) i1,j1
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) .and. &
- freeres(i1,j1,nsec,isec)) goto 5
- enddo
- not_done=.false.
- 5 continue
-!d write (iout,*) i1,j1,not_done
- enddo
- j1=j1-1
- i1=i1-1
- if (i1-ii1.gt.1) then
- ii1=max0(ii1-1,1)
- jj1=max0(jj1-1,1)
- nbeta=nbeta+1
- if(lprint)write(iout,'(a,i3,4i4)')'parallel beta',&
- nbeta,ii1,i1,jj1,j1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1+1
- bfrag(2,nbfrag)=i1+1
- bfrag(3,nbfrag)=jj1+1
- bfrag(4,nbfrag)=min0(j1+1,nres)
-
- do ij=ii1,i1
- nsec(ij)=nsec(ij)+1
- isec(ij,nsec(ij))=nbeta
- enddo
- do ij=jj1,j1
- nsec(ij)=nsec(ij)+1
- isec(ij,nsec(ij))=nbeta
- enddo
-
- if(lprint) then
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-1,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-1,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",jj1-1,"..",j1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",jj1-1,"..",j1-1,"'"
- endif
- write(12,'(a8,4i4)') &
- "SetNeigh",ii1-1,i1-1,jj1-1,j1-1
- endif
- endif
- endif
- enddo
-
-! finding alpha or 310 helix
- nhelix=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- p1=phi(i1+2)*rad2deg
- p2=0.0
- if (j1+2.le.nres) p2=phi(j1+2)*rad2deg
-
-
- if (j1.eq.i1+3 .and. &
- ((p1.ge.10.and.p1.le.80).or.i1.le.2).and. &
- ((p2.ge.10.and.p2.le.80).or.j1.le.2.or.j1.ge.nres-3) )then
-!d if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2
-!o if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,p1,p2
- ii1=i1
- jj1=j1
- if (nsec(ii1).eq.0) then
- not_done=.true.
- else
- not_done=.false.
- endif
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
- p1=phi(i1+2)*rad2deg
- p2=phi(j1+2)*rad2deg
- if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80) &
- not_done=.false.
-!d
- enddo
- j1=j1+1
- if (j1-ii1.gt.5) then
- nhelix=nhelix+1
-!d
-
- nhfrag=nhfrag+1
- hfrag(1,nhfrag)=ii1
- hfrag(2,nhfrag)=j1
-
- do ij=ii1,j1
- nsec(ij)=-1
- enddo
- if (lprint) then
- write (iout,'(a,i3,2i4)') "Helix",nhelix,ii1-1,j1-1
- if (nhelix.le.9) then
- write(12,'(a17,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'helix",nhelix,&
- "' 'num = ",ii1-1,"..",j1-2,"'"
- else
- write(12,'(a17,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'helix",nhelix,&
- "' 'num = ",ii1-1,"..",j1-2,"'"
- endif
- endif
- endif
- endif
- enddo
- if (nhelix.gt.0.and.lprint) then
- write(12,'(a26,$)') "DefPropRes 'helix' 'helix1"
- do i=2,nhelix
- if (nhelix.le.9) then
- write(12,'(a8,i1,$)') " | helix",i
- else
- write(12,'(a8,i2,$)') " | helix",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-! finding antiparallel beta
-!d write (iout,*) '--------- looking for antiparallel beta ---------'
-
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (freeres(i1,j1,nsec,isec)) then
- ii1=i1
- jj1=j1
-!d write (iout,*) i1,j1
-
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1-1
- do j=1,ncont
- if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. &
- freeres(i1,j1,nsec,isec)) goto 6
- enddo
- not_done=.false.
- 6 continue
-!d write (iout,*) i1,j1,not_done
- enddo
- i1=i1-1
- j1=j1+1
- if (i1-ii1.gt.1) then
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1
- bfrag(2,nbfrag)=min0(i1+1,nres)
- bfrag(3,nbfrag)=min0(jj1+1,nres)
- bfrag(4,nbfrag)=j1
-
- nbeta=nbeta+1
- iii1=max0(ii1-1,1)
- do ij=iii1,i1
- nsec(ij)=nsec(ij)+1
- if (nsec(ij).le.2) then
- isec(ij,nsec(ij))=nbeta
- endif
- enddo
- jjj1=max0(j1-1,1)
- do ij=jjj1,jj1
- nsec(ij)=nsec(ij)+1
- if (nsec(ij).le.2 .and. nsec(ij).gt.0) then
- isec(ij,nsec(ij))=nbeta
- endif
- enddo
-
-
- if (lprint) then
- write (iout,'(a,i3,4i4)')'antiparallel beta',&
- nbeta,ii1-1,i1,jj1,j1-1
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-2,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-2,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",j1-2,"..",jj1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",j1-2,"..",jj1-1,"'"
- endif
- write(12,'(a8,4i4)') &
- "SetNeigh",ii1-2,i1-1,jj1-1,j1-2
- endif
- endif
- endif
- enddo
-
- if (nstrand.gt.0.and.lprint) then
- write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1"
- do i=2,nstrand
- if (i.le.9) then
- write(12,'(a9,i1,$)') " | strand",i
- else
- write(12,'(a9,i2,$)') " | strand",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-
- if (lprint) then
- write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'"
- write(12,'(a20)') "XMacStand ribbon.mac"
-
-
- write(iout,*) 'UNRES seq:'
- do j=1,nbfrag
- write(iout,*) 'beta ',(bfrag(i,j),i=1,4)
- enddo
-
- do j=1,nhfrag
- write(iout,*) 'helix ',(hfrag(i,j),i=1,2)
- enddo
- endif
-
- return
- end subroutine secondary2
-#endif
-!-----------------------------------------------------------------------------
- logical function freeres(i,j,nsec,isec)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- integer,dimension(nres,4) :: isec !(maxres,4)
- integer,dimension(nres) :: nsec !(maxres)
-
-!el local variables
- integer :: i,j,k,l
-
- freeres=.false.
-#ifndef WHAM_RUN
- if (nsec(i).lt.0.or.nsec(j).lt.0) return
-#endif
- if (nsec(i).gt.1.or.nsec(j).gt.1) return
- do k=1,nsec(i)
- do l=1,nsec(j)
- if (isec(i,k).eq.isec(j,l)) return
- enddo
- enddo
- freeres=.true.
- return
- end function freeres
-!-----------------------------------------------------------------------------
-! readrtns_CSA.F
-!-----------------------------------------------------------------------------
- logical function seq_comp(itypea,itypeb,length)
-
-!el implicit none
- integer :: length,itypea(length),itypeb(length)
- integer :: i
- do i=1,length
- if (itypea(i).ne.itypeb(i)) then
- seq_comp=.false.
- return
- endif
- enddo
- seq_comp=.true.
- return
- end function seq_comp
-#ifndef WHAM_RUN
-!-----------------------------------------------------------------------------
-! rmsd.F
-!-----------------------------------------------------------------------------
- subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.IOUNITS'
- real(kind=8) :: przes(3),obr(3,3)
- logical :: non_conv,lprn
- real(kind=8) :: rms,frac,frac_nn,co
-! call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes,
-! & obr,non_conv)
-! rms=dsqrt(rms)
- call rmsd(rms)
-!elte(iout,*) "rms_nacc before contact"
- call contact(.false.,ncont,icont,co)
- frac=contact_fract(ncont,ncont_ref,icont,icont_ref)
- frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref)
- if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)') &
- 'RMS deviation from the reference structure:',rms,&
- ' % of native contacts:',frac*100,&
- ' % of nonnative contacts:',frac_nn*100,&
- ' contact order:',co
-
- return
- end subroutine rms_nac_nnc
-!-----------------------------------------------------------------------------
- subroutine rmsd(drms)
-
- use regularize_, only:fitsq
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.INTERACT'
-! include 'COMMON.CONTROL'
- logical :: non_conv
- real(kind=8) :: przes(3),obrot(3,3)
- real(kind=8),dimension(3,2*nres+2) :: ccopy,crefcopy !(3,maxres2+2) maxres2=2*maxres
-
-!el local variables
- real(kind=8) :: drms,rminroz,roznica
- integer :: i,j,iatom,kkk,iti,k
-
-!el allocate(ccopy(3,2*nres+2),crefcopy(3,2*nres+2)) !(3,maxres2+2) maxres2=2*maxres
-
- nperm=1
- do i=1,symetr
- nperm=nperm*i
- enddo
- iatom=0
- rminroz=100d2
-! print *,"nz_start",nz_start," nz_end",nz_end
-! if (symetr.le.1) then
- do kkk=1,nperm
-! do i=nz_start,nz_end
-! iatom=iatom+1
-! iti=itype(i)
-! do k=1,3
-! ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup)
-! crefcopy(k,iatom,kkk)=cref(k,i,kkk)
-! enddo
-! if (iz_sc.eq.1.and.iti.ne.10) then
-! iatom=iatom+1
-! do k=1,3
-! ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup)
-! crefcopy(k,iatom,kkk)=cref(k,nres+i,kkk)
-! enddo
-! endif
-! enddo
-! else
-! do kkk=1,nperm
- iatom=0
- do i=nz_start,nz_end
- iatom=iatom+1
- iti=itype(i)
- do k=1,3
- ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup)
- crefcopy(k,iatom)=cref(k,i,kkk)
- enddo
- if (iz_sc.eq.1.and.iti.ne.10) then
- iatom=iatom+1
- do k=1,3
- ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup)
- crefcopy(k,iatom)=cref(k,nres+i,kkk)
- enddo
- endif
- enddo
-! enddo
-! endif
-
-! ----- diagnostics
-! do kkk=1,nperm
-! write (iout,*) 'Ccopy and CREFcopy'
-! print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),
-! & (crefcopy(j,k),j=1,3),k=1,iatom)
-! write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),
-! & (crefcopy(j,k),j=1,3),k=1,iatom)
-! enddo
-! ----- end diagnostics
-! do kkk=1,nperm
- call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,&
- przes,obrot,non_conv)
- if (non_conv) then
- print *,'Problems in FITSQ!!! rmsd'
- write (iout,*) 'Problems in FITSQ!!! rmsd'
- print *,'Ccopy and CREFcopy'
- write (iout,*) 'Ccopy and CREFcopy'
- print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),&
- (crefcopy(j,k),j=1,3),k=1,iatom)
- write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),&
- (crefcopy(j,k),j=1,3),k=1,iatom)
-#ifdef MPI
-! call mpi_abort(mpi_comm_world,ierror,ierrcode)
- roznica=100.0d10
-#else
- stop
-#endif
- endif
-! write (iout,*) "roznica", roznica,kkk
- if (roznica.le.rminroz) rminroz=roznica
- enddo
- drms=dsqrt(dabs(rminroz))
-! ---- diagnostics
-! write (iout,*) "nperm,symetr", nperm,symetr
-! ---- end diagnostics
- return
- end subroutine rmsd
-!-----------------------------------------------------------------------------
- subroutine rmsd_csa(drms)
-
- use regularize_, only:fitsq
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-#ifdef MPI
- include 'mpif.h'
-#endif
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.INTERACT'
- logical :: non_conv
- real(kind=8) :: przes(3),obrot(3,3)
- real(kind=8),dimension(:,:),allocatable :: ccopy,crefcopy !(3,maxres2+2) maxres2=2*maxres
- integer :: kkk,iatom,ierror,ierrcode
-
-!el local variables
- integer ::i,j,k,iti
- real(kind=8) :: drms,roznica
-
- allocate(ccopy(3,2*nres+2),crefcopy(3,2*nres+2)) !(3,maxres2+2) maxres2=2*maxres
-
- kkk=1
- iatom=0
- do i=nz_start,nz_end
- iatom=iatom+1
- iti=itype(i)
- do k=1,3
- ccopy(k,iatom)=c(k,i)
- crefcopy(k,iatom)=crefjlee(k,i)
- enddo
- if (iz_sc.eq.1.and.iti.ne.10) then
- iatom=iatom+1
- do k=1,3
- ccopy(k,iatom)=c(k,nres+i)
- crefcopy(k,iatom)=crefjlee(k,nres+i)
- enddo
- endif
- enddo
-
- call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom,&
- przes,obrot,non_conv)
- if (non_conv) then
- print *,'Problems in FITSQ!!! rmsd_csa'
- write (iout,*) 'Problems in FITSQ!!! rmsd_csa'
- print *,'Ccopy and CREFcopy'
- write (iout,*) 'Ccopy and CREFcopy'
- print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3),&
- (crefcopy(j,k),j=1,3),k=1,iatom)
- write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3),&
- (crefcopy(j,k),j=1,3),k=1,iatom)
-#ifdef MPI
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
-#else
- stop
-#endif
- endif
- drms=dsqrt(dabs(roznica))
- return
- end subroutine rmsd_csa
-!-----------------------------------------------------------------------------
-! test.F
-!-----------------------------------------------------------------------------
- subroutine test
-
-!el use minim
- use geometry, only:pinorm
- use random, only:ran_number,iran_num
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CONTROL'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-! include 'COMMON.CHAIN'
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: var,var1 !(maxvar) (maxvar=6*maxres)
- integer :: j1,j2,jr,i,iretcode,nfun,nft_sc
- logical :: debug,accepted
- real(kind=8) :: etot,rms,da,temp,betbol,etot0,d,phiold,&
- xxr,xxh
- debug=.true.
-!el allocate(var(6*nres),var1(6*nres)) !(maxvar) (maxvar=6*maxres)
-
- call geom_to_var(nvar,var1)
- call chainbuild
- call etotal(energy)
- etot=energy(0)
- call rmsd(rms)
- write(iout,*) 'etot=',0,etot,rms
- call secondary2(.false.)
-
- call write_pdb(0,'first structure',etot)
-
- j1=13
- j2=21
- da=180.0*deg2rad
-
-
-
- temp=3000.0d0
- betbol=1.0D0/(1.9858D-3*temp)
- jr=iran_num(j1,j2)
- d=ran_number(-pi,pi)
-! phi(jr)=pinorm(phi(jr)+d)
- call chainbuild
- call etotal(energy)
- etot0=energy(0)
- call rmsd(rms)
- write(iout,*) 'etot=',1,etot0,rms
- call write_pdb(1,'perturb structure',etot0)
-
- do i=2,500,2
- jr=iran_num(j1,j2)
- d=ran_number(-da,da)
- phiold=phi(jr)
- phi(jr)=pinorm(phi(jr)+d)
- call chainbuild
- call etotal(energy)
- etot=energy(0)
-
- if (etot.lt.etot0) then
- accepted=.true.
- else
- accepted=.false.
- xxr=ran_number(0.0D0,1.0D0)
- xxh=betbol*(etot-etot0)
- if (xxh.lt.50.0D0) then
- xxh=dexp(-xxh)
- if (xxh.gt.xxr) accepted=.true.
- endif
- endif
- accepted=.true.
-! print *,etot0,etot,accepted
- if (accepted) then
- etot0=etot
- call rmsd(rms)
- write(iout,*) 'etot=',i,etot,rms
- call write_pdb(i,'MC structure',etot)
-! minimize
-! call geom_to_var(nvar,var1)
- call sc_move(2,nres-1,1,10d0,nft_sc,etot)
- call geom_to_var(nvar,var)
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun
- call var_to_geom(nvar,var)
- call chainbuild
- call rmsd(rms)
- write(iout,*) 'etot mcm=',i,etot,rms
- call write_pdb(i+1,'MCM structure',etot)
- call var_to_geom(nvar,var1)
-! --------
- else
- phi(jr)=phiold
- endif
- enddo
-
-! minimize
-! call sc_move(2,nres-1,1,10d0,nft_sc,etot)
-! call geom_to_var(nvar,var)
-!
-! call chainbuild
-! call write_pdb(998 ,'sc min',etot)
-!
-! call minimize(etot,var,iretcode,nfun)
-! write(iout,*)'------------------------------------------------'
-! write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun
-!
-! call var_to_geom(nvar,var)
-! call chainbuild
-! call write_pdb(999,'full min',etot)
-
- return
- end subroutine test
-!-----------------------------------------------------------------------------
-!el#ifdef MPI
- subroutine test_n16
-
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CONTROL'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-! include 'COMMON.CHAIN'
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(:),allocatable :: var,var1 !(maxvar) (maxvar=6*maxres)
- integer :: jdata(5)
- logical :: debug
-!el local variables
- integer :: i,ij,ieval,iretcode,nfun
- real(kind=8) :: etot
- debug=.true.
- allocate(var(6*nres),var1(6*nres)) !(maxvar) (maxvar=6*maxres)
-!
- call geom_to_var(nvar,var1)
- call chainbuild
- call etotal(energy)
- etot=energy(0)
- write(iout,*) nnt,nct,etot
- call write_pdb(1,'first structure',etot)
- call secondary2(.true.)
-
- do i=1,4
- jdata(i)=bfrag(i,2)
- enddo
-
- DO ij=1,4
- ieval=0
- jdata(5)=ij
- call var_to_geom(nvar,var1)
- write(iout,*) 'N16 test',(jdata(i),i=1,5)
- call beta_slide(jdata(1),jdata(2),jdata(3),jdata(4),jdata(5), &
- ieval,ij)
- call geom_to_var(nvar,var)
-
- if (minim) then
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,&
- '+ DIST eval',ieval
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(ij*100+99,'full min',etot)
- endif
-
-
- ENDDO
-
- return
- end subroutine test_n16
-!el#endif
-!-----------------------------------------------------------------------------
- subroutine test_local
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: varia !(maxvar) (maxvar=6*maxres)
- integer :: nft_sc
- real(kind=8) :: etot
-!
-! allocate(varia(6*nres)) !(maxvar) (maxvar=6*maxres)
- call chainbuild
-! call geom_to_var(nvar,varia)
- call write_pdb(1,'first structure',0d0)
-
- call etotal(energy)
- etot=energy(0)
- write(iout,*) nnt,nct,etot
-
- write(iout,*) 'calling sc_move'
- call sc_move(nnt,nct,5,10d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(2,'second structure',etot)
-
- write(iout,*) 'calling local_move'
- call local_move_init(.false.)
- call local_move(24,29,20d0,50d0)
- call chainbuild
- call write_pdb(3,'third structure',etot)
-
- write(iout,*) 'calling sc_move'
- call sc_move(24,29,5,10d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(2,'last structure',etot)
-
- return
- end subroutine test_local
-!-----------------------------------------------------------------------------
- subroutine test_sc
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
- real(kind=8) :: time0,time1,etot
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: varia !(maxvar) (maxvar=6*maxres)
- integer :: nft_sc
-!
- call chainbuild
-! call geom_to_var(nvar,varia)
- call write_pdb(1,'first structure',0d0)
-
- call etotal(energy)
- etot=energy(0)
- write(iout,*) nnt,nct,etot
-
- write(iout,*) 'calling sc_move'
-
- call sc_move(nnt,nct,5,10d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(2,'second structure',etot)
-
- write(iout,*) 'calling sc_move 2nd time'
-
- call sc_move(nnt,nct,5,1d0,nft_sc,etot)
- write(iout,*) nft_sc,etot
- call write_pdb(3,'last structure',etot)
- return
- end subroutine test_sc
-!-----------------------------------------------------------------------------
- subroutine bgrow(bstrand,nbstrand,in,ind,new)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
- integer,dimension(nres/3,6) :: bstrand !(maxres/3,6)
-
-!el local variables
- integer :: nbstrand,in,ind,new,ishift,i
-
- ishift=iabs(bstrand(in,ind+4)-new)
-
- print *,'bgrow',bstrand(in,ind+4),new,ishift
-
- bstrand(in,ind)=new
-
- if(ind.eq.1)then
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- do i=1,nbstrand-1
- IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN
- if (bstrand(i,5).lt.bstrand(i,6)) then
- bstrand(i,5)=bstrand(i,5)-ishift
- else
- bstrand(i,5)=bstrand(i,5)+ishift
- endif
- ENDIF
- enddo
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- do i=1,nbstrand-1
- IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN
- if (bstrand(i,6).lt.bstrand(i,5)) then
- bstrand(i,6)=bstrand(i,6)-ishift
- else
- bstrand(i,6)=bstrand(i,6)+ishift
- endif
- ENDIF
- enddo
- endif
-
- return
- end subroutine bgrow
-!-----------------------------------------------------------------------------
- subroutine test11
-
- use geometry, only:dist
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTROL'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-!
-! include 'COMMON.DISTFIT'
- integer :: if(20,nres),nif,ifa(20)
- integer :: ibc(0:nres,0:nres),istrand(20)
- integer :: ibd(nres),ifb(10,2),nifb,lifb(10),lifb0
- integer :: itmp(20,nres)
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: varia,vorg !(maxvar) (maxvar=6*maxres)
-!
- logical :: debug,ltest,usedbfrag(nres/3)
- character(len=50) :: linia
-!
- integer :: betasheet(nres),ibetasheet(nres),nbetasheet
- integer :: bstrand(nres/3,6),nbstrand
- real(kind=8) :: etot
- integer :: i,j,jk,k,isa,m,l,ig,iconf,is,ii,iused_nbfrag,&
- in,ind,ifun,nfun,iretcode
-!------------------------
-
- debug=.true.
-!------------------------
- nbstrand=0
- nbetasheet=0
- do i=1,nres
- betasheet(i)=0
- ibetasheet(i)=0
- enddo
- call geom_to_var(nvar,vorg)
- call secondary2(debug)
-
- if (nbfrag.le.1) return
-
- do i=1,nbfrag
- usedbfrag(i)=.false.
- enddo
-
-
- nbetasheet=nbetasheet+1
- nbstrand=2
- bstrand(1,1)=bfrag(1,1)
- bstrand(1,2)=bfrag(2,1)
- bstrand(1,3)=nbetasheet
- bstrand(1,4)=1
- bstrand(1,5)=bfrag(1,1)
- bstrand(1,6)=bfrag(2,1)
- do i=bfrag(1,1),bfrag(2,1)
- betasheet(i)=nbetasheet
- ibetasheet(i)=1
- enddo
-!
- bstrand(2,1)=bfrag(3,1)
- bstrand(2,2)=bfrag(4,1)
- bstrand(2,3)=nbetasheet
- bstrand(2,5)=bfrag(3,1)
- bstrand(2,6)=bfrag(4,1)
-
- if (bfrag(3,1).le.bfrag(4,1)) then
- bstrand(2,4)=2
- do i=bfrag(3,1),bfrag(4,1)
- betasheet(i)=nbetasheet
- ibetasheet(i)=2
- enddo
- else
- bstrand(2,4)=-2
- do i=bfrag(4,1),bfrag(3,1)
- betasheet(i)=nbetasheet
- ibetasheet(i)=2
- enddo
- endif
-
- iused_nbfrag=1
-
- do while (iused_nbfrag.ne.nbfrag)
-
- do j=2,nbfrag
-
- IF (.not.usedbfrag(j)) THEN
-
- write (*,*) j,(bfrag(i,j),i=1,4)
- do jk=6,1,-1
- write (*,'(i4,a3,10i4)') jk,'B',(bstrand(i,jk),i=1,nbstrand)
- enddo
- write (*,*) '------------------'
-
-
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- if(betasheet(i).eq.nbetasheet) then
- in=ibetasheet(i)
- do k=bfrag(3,j),bfrag(4,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(2,j)
- bstrand(nbstrand,2)=bfrag(1,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(4,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+&
- (bstrand(in,5)-bfrag(4,j))
- endif
- if(bstrand(in,2).gt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(3,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-&
- (-bstrand(in,6)+bfrag(3,j))
- endif
- else
- bstrand(nbstrand,1)=bfrag(1,j)
- bstrand(nbstrand,2)=bfrag(2,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(3,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-&
- (-bstrand(in,5)+bfrag(3,j))
- endif
- if(bstrand(in,2).lt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(4,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+&
- (bstrand(in,6)-bfrag(4,j))
- endif
- endif
- goto 11
- endif
- if(betasheet(bfrag(1,j)+i-bfrag(3,j)).eq.nbetasheet) then
- in=ibetasheet(bfrag(1,j)+i-bfrag(3,j))
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(3,1),bfrag(4,1)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(4,j)
- bstrand(nbstrand,2)=bfrag(3,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(2,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+&
- (bstrand(in,5)-bfrag(2,j))
- endif
- if(bstrand(in,2).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(1,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-&
- (-bstrand(in,6)+bfrag(1,j))
- endif
- else
- bstrand(nbstrand,1)=bfrag(3,j)
- bstrand(nbstrand,2)=bfrag(4,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(1,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-&
- (-bstrand(in,5)+bfrag(1,j))
- endif
- if(bstrand(in,2).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(2,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+&
- (bstrand(in,6)-bfrag(2,j))
- endif
- endif
- goto 11
- endif
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- if(betasheet(i).eq.nbetasheet) then
- in=ibetasheet(i)
- do k=bfrag(4,j),bfrag(3,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(1,j)
- bstrand(nbstrand,2)=bfrag(2,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(3,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-&
- (bstrand(in,5)-bfrag(3,j))
- endif
- if(bstrand(in,2).gt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(4,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+&
- (-bstrand(in,6)+bfrag(4,j))
- endif
- else
- bstrand(nbstrand,1)=bfrag(2,j)
- bstrand(nbstrand,2)=bfrag(1,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(4,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(4,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+&
- (-bstrand(in,5)+bfrag(4,j))
- endif
- if(bstrand(in,2).lt.bfrag(3,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(3,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-&
- (bstrand(in,6)-bfrag(3,j))
- endif
- endif
- goto 11
- endif
- if(betasheet(bfrag(2,j)-i+bfrag(4,j)).eq.nbetasheet) then
- in=ibetasheet(bfrag(2,j)-i+bfrag(4,j))
- do k=bfrag(1,j),bfrag(2,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=in
- enddo
- nbstrand=nbstrand+1
- usedbfrag(j)=.true.
- iused_nbfrag=iused_nbfrag+1
- do k=bfrag(4,j),bfrag(3,j)
- betasheet(k)=nbetasheet
- ibetasheet(k)=nbstrand
- enddo
- if (bstrand(in,4).lt.0) then
- bstrand(nbstrand,1)=bfrag(4,j)
- bstrand(nbstrand,2)=bfrag(3,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(2,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)-&
- (bstrand(in,5)-bfrag(2,j))
- endif
- if(bstrand(in,2).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(1,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)+&
- (-bstrand(in,6)+bfrag(1,j))
- endif
- else
- bstrand(nbstrand,1)=bfrag(3,j)
- bstrand(nbstrand,2)=bfrag(4,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,4)=-nbstrand
- bstrand(nbstrand,5)=bstrand(nbstrand,1)
- bstrand(nbstrand,6)=bstrand(nbstrand,2)
- if(bstrand(in,1).gt.bfrag(1,j)) then
- call bgrow(bstrand,nbstrand,in,1,bfrag(1,j))
- else
- bstrand(nbstrand,5)=bstrand(nbstrand,5)+&
- (-bstrand(in,5)+bfrag(1,j))
- endif
- if(bstrand(in,2).lt.bfrag(2,j)) then
- call bgrow(bstrand,nbstrand,in,2,bfrag(2,j))
- else
- bstrand(nbstrand,6)=bstrand(nbstrand,6)-&
- (bstrand(in,6)-bfrag(2,j))
- endif
- endif
- goto 11
- endif
- enddo
- endif
-
-
-
- ENDIF
- enddo
-
- j=2
- do while (usedbfrag(j))
- j=j+1
- enddo
-
- nbstrand=nbstrand+1
- nbetasheet=nbetasheet+1
- bstrand(nbstrand,1)=bfrag(1,j)
- bstrand(nbstrand,2)=bfrag(2,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,5)=bfrag(1,j)
- bstrand(nbstrand,6)=bfrag(2,j)
-
- bstrand(nbstrand,4)=nbstrand
- do i=bfrag(1,j),bfrag(2,j)
- betasheet(i)=nbetasheet
- ibetasheet(i)=nbstrand
- enddo
-!
- nbstrand=nbstrand+1
- bstrand(nbstrand,1)=bfrag(3,j)
- bstrand(nbstrand,2)=bfrag(4,j)
- bstrand(nbstrand,3)=nbetasheet
- bstrand(nbstrand,5)=bfrag(3,j)
- bstrand(nbstrand,6)=bfrag(4,j)
-
- if (bfrag(3,j).le.bfrag(4,j)) then
- bstrand(nbstrand,4)=nbstrand
- do i=bfrag(3,j),bfrag(4,j)
- betasheet(i)=nbetasheet
- ibetasheet(i)=nbstrand
- enddo
- else
- bstrand(nbstrand,4)=-nbstrand
- do i=bfrag(4,j),bfrag(3,j)
- betasheet(i)=nbetasheet
- ibetasheet(i)=nbstrand
- enddo
- endif
-
- iused_nbfrag=iused_nbfrag+1
- usedbfrag(j)=.true.
-
-
- 11 continue
- do jk=6,1,-1
- write (*,'(i4,a3,10i4)') jk,'A',(bstrand(i,jk),i=1,nbstrand)
- enddo
-
-
- enddo
-
- do i=1,nres
- if (betasheet(i).ne.0) write(*,*) i,betasheet(i),ibetasheet(i)
- enddo
- write(*,*)
- do j=6,1,-1
- write (*,'(i4,a3,10i4)') j,':',(bstrand(i,j),i=1,nbstrand)
- enddo
-
-!------------------------
- nifb=0
- do i=1,nbstrand
- do j=i+1,nbstrand
- if(iabs(bstrand(i,5)-bstrand(j,5)).le.5 .or. &
- iabs(bstrand(i,6)-bstrand(j,6)).le.5 ) then
- nifb=nifb+1
- ifb(nifb,1)=bstrand(i,4)
- ifb(nifb,2)=bstrand(j,4)
- endif
- enddo
- enddo
-
- write(*,*)
- do i=1,nifb
- write (*,'(a3,20i4)') "ifb",i,ifb(i,1),ifb(i,2)
- enddo
-
- do i=1,nbstrand
- ifa(i)=bstrand(i,4)
- enddo
- write (*,'(a3,20i4)') "ifa",(ifa(i),i=1,nbstrand)
-
- nif=iabs(bstrand(1,6)-bstrand(1,5))+1
- do j=2,nbstrand
- if (iabs(bstrand(j,6)-bstrand(j,5))+1.gt.nif) &
- nif=iabs(bstrand(j,6)-bstrand(j,5))+1
- enddo
-
- write(*,*) nif
- do i=1,nif
- do j=1,nbstrand
- if(j,i)=bstrand(j,6)+(i-1)*sign(1,bstrand(j,5)-bstrand(j,6))
- if (if(j,i).gt.0) then
- if(betasheet(if(j,i)).eq.0 .or. &
- ibetasheet(if(j,i)).ne.iabs(bstrand(j,4))) if(j,i)=0
- else
- if(j,i)=0
- endif
- enddo
- write(*,'(a3,10i4)') 'if ',(if(j,i),j=1,nbstrand)
- enddo
-
-! read (inp,*) (ifa(i),i=1,4)
-! do i=1,nres
-! read (inp,*,err=20,end=20) (if(j,i),j=1,4)
-! enddo
-! 20 nif=i-1
- stop
-!------------------------
-
- isa=4
- is=2*isa-1
- iconf=0
-!ccccccccccccccccccccccccccccccccc
- DO ig=1,is**isa-1
-!ccccccccccccccccccccccccccccccccc
-
- ii=ig
- do j=1,is
- istrand(is-j+1)=int(ii/is**(is-j))
- ii=ii-istrand(is-j+1)*is**(is-j)
- enddo
- ltest=.true.
- do k=1,isa
- istrand(k)=istrand(k)+1
- if(istrand(k).gt.isa) istrand(k)=istrand(k)-2*isa-1
- enddo
- do k=1,isa
- do l=1,isa
- if(istrand(k).eq.istrand(l).and.k.ne.l.or. &
- istrand(k).eq.-istrand(l).and.k.ne.l) ltest=.false.
- enddo
- enddo
-
- lifb0=1
- do m=1,nifb
- lifb(m)=0
- do k=1,isa-1
- if( &
- ifb(m,1).eq.istrand(k).and.ifb(m,2).eq.istrand(k+1).or. &
- ifb(m,2).eq.istrand(k).and.ifb(m,1).eq.istrand(k+1).or. &
- -ifb(m,1).eq.istrand(k).and.-ifb(m,2).eq.istrand(k+1).or. &
- -ifb(m,2).eq.istrand(k).and.-ifb(m,1).eq.istrand(k+1)) &
- lifb(m)=1
- enddo
- lifb0=lifb0*lifb(m)
- enddo
-
- if (mod(isa,2).eq.0) then
- do k=isa/2+1,isa
- if (istrand(k).eq.1) ltest=.false.
- enddo
- else
- do k=(isa+1)/2+1,isa
- if (istrand(k).eq.1) ltest=.false.
- enddo
- endif
-
- IF (ltest.and.lifb0.eq.1) THEN
- iconf=iconf+1
-
- call var_to_geom(nvar,vorg)
-
- write (*,'(i5,i10,10i3)') iconf,ig,(istrand(k),k=1,isa)
- write (iout,'(i5,i10,10i3)') iconf,ig,(istrand(k),k=1,isa)
- write (linia,'(10i3)') (istrand(k),k=1,isa)
-
- do i=1,nres
- do j=1,nres
- ibc(i,j)=0
- enddo
- enddo
-
-
- do i=1,4
- if ( sign(1,istrand(i)).eq.sign(1,ifa(iabs(istrand(i)))) ) then
- do j=1,nif
- itmp(iabs(istrand(i)),j)=if(iabs(ifa(iabs(istrand(i)))),j)
- enddo
- else
- do j=1,nif
- itmp(iabs(istrand(i)),j)=if(iabs(ifa(iabs(istrand(i)))),nif-j+1)
- enddo
- endif
- enddo
-
- do i=1,nif
- write(*,*) (itmp(j,i),j=1,4)
- enddo
-
- do i=1,nif
-! ifa(1),ifa(2),ifa(3),ifa(4)
-! if(1,i),if(2,i),if(3,i),if(4,i)
- do k=1,isa-1
- ltest=.false.
- do m=1,nifb
- if( &
- ifb(m,1).eq.istrand(k).and.ifb(m,2).eq.istrand(k+1).or. &
- ifb(m,2).eq.istrand(k).and.ifb(m,1).eq.istrand(k+1).or. &
- -ifb(m,1).eq.istrand(k).and.-ifb(m,2).eq.istrand(k+1).or. &
- -ifb(m,2).eq.istrand(k).and.-ifb(m,1).eq.istrand(k+1)) &
- then
- ltest=.true.
- goto 110
- endif
- enddo
- 110 continue
- if (ltest) then
- ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+1)),i))=-1
- else
- ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+1)),i))=-2
- endif
-!
- if (k.lt.3) &
- ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+2)),i))=-3
- if (k.lt.2) &
- ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+3)),i))=-4
- enddo
- enddo
-!------------------------
-
-!
-! freeze sec.elements
-!
- do i=1,nres
- mask(i)=1
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-!------------------------
-! generate constrains
-!
- nhpb0=nhpb
- call chainbuild
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( ibc(i,j).eq.-1 .or. ibc(j,i).eq.-1) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).eq.-2 .or. ibc(j,i).eq.-2) then
- d0(ind)=5.0
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).eq.-3 .or. ibc(j,i).eq.-3) then
- d0(ind)=11.0
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).eq.-4 .or. ibc(j,i).eq.-4) then
- d0(ind)=16.0
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).gt.0 ) then
- d0(ind)=DIST(i,ibc(i,j))
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(j,i).gt.0 ) then
- d0(ind)=DIST(ibc(j,i),j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- ddd(ind)=d0(ind)
- enddo
- enddo
- call hpb_partition
-!d--------------------------
-
- write(iout,'(i3,2i4,a3,2i4,f7.2)') (i,ibc(ihpb(i),jhpb(i)),&
- ibc(jhpb(i),ihpb(i)),' --',&
- ihpb(i),jhpb(i),dhpb(i),i=1,nhpb)
-
-!d nhpb=0
-!d goto 901
-!
-!
-!el#ifdef MPI
- call contact_cp_min(varia,ifun,iconf,linia,debug)
- if (minim) then
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,varia,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,&
- '+ DIST eval',ifun
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
- write (linia,'(a10,10i3)') 'full_min',(istrand(k),k=1,isa)
- call var_to_geom(nvar,varia)
- call chainbuild
- call write_pdb(900+iconf,linia,etot)
- endif
-!el#endif
- call etotal(energy)
- etot=energy(0)
- call enerprint(energy)
-!d call intout
-!d call briefout(0,etot)
-!d call secondary2(.true.)
-
- 901 CONTINUE
-!test return
-!ccccccccccccccccccccccccccccccccccc
- ENDIF
- ENDDO
-!ccccccccccccccccccccccccccccccccccc
-
- return
- 10 write (iout,'(a)') 'Error reading test structure.'
- return
- end subroutine test11
-!-----------------------------------------------------------------------------
- subroutine test3
-
- use geometry, only:dist
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTROL'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-!
-! include 'COMMON.DISTFIT'
- integer :: if(3,nres),nif
- integer :: ibc(nres,nres),istrand(20)
- integer :: ibd(nres),ifb(10,2),nifb,lifb(10),lifb0
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: varia !(maxvar) (maxvar=6*maxres)
-!
- logical :: debug,ltest
- character(len=50) :: linia
- integer :: ieval,i,j,ind,in_pdb,nfun,iretcode
- real(kind=8) :: etot
-!
- do i=1,nres
- read (inp,*,err=20,end=20) if(1,i),if(2,i),if(3,i)
- enddo
- 20 nif=i-1
- write (*,'(a4,3i5)') ('if =',if(1,i),if(2,i),if(3,i),&
- i=1,nif)
-
-
-!------------------------
- call secondary2(debug)
-!------------------------
- do i=1,nres
- do j=1,nres
- ibc(i,j)=0
- enddo
- enddo
-
-!
-! freeze sec.elements and store indexes for beta constrains
-!
- do i=1,nres
- mask(i)=1
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- ibc(bfrag(1,j)+i-bfrag(3,j),i)=-1
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- ibc(bfrag(2,j)-i+bfrag(4,j),i)=-1
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-
-! ---------------- test --------------
- do i=1,nif
- if (ibc(if(1,i),if(2,i)).eq.-1) then
- ibc(if(1,i),if(2,i))=if(3,i)
- ibc(if(1,i),if(3,i))=if(2,i)
- else if (ibc(if(2,i),if(1,i)).eq.-1) then
- ibc(if(2,i),if(1,i))=0
- ibc(if(1,i),if(2,i))=if(3,i)
- ibc(if(1,i),if(3,i))=if(2,i)
- else
- ibc(if(1,i),if(2,i))=if(3,i)
- ibc(if(1,i),if(3,i))=if(2,i)
- endif
- enddo
-
- do i=1,nres
- do j=1,nres
- if (ibc(i,j).ne.0) write(*,'(3i5)') i,j,ibc(i,j)
- enddo
- enddo
-!------------------------
- call chainbuild
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( ibc(i,j).eq.-1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(i,j).gt.0 ) then
- d0(ind)=DIST(i,ibc(i,j))
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else if ( ibc(j,i).gt.0 ) then
- d0(ind)=DIST(ibc(j,i),j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
-!d--------------------------
- write(*,'(i3,2i4,a3,2i4,f7.2)') (i,ibc(ihpb(i),jhpb(i)),&
- ibc(jhpb(i),ihpb(i)),' --',&
- ihpb(i),jhpb(i),dhpb(i),i=1,nhpb)
-
-
- linia='dist'
- debug=.true.
- in_pdb=7
-!
-!el#ifdef MPI
- call contact_cp_min(varia,ieval,in_pdb,linia,debug)
- if (minim) then
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,varia,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,&
- '+ DIST eval',ieval
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,varia)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-!el#endif
- call etotal(energy)
- etot=energy(0)
- call enerprint(energy)
- call intout
- call briefout(0,etot)
- call secondary2(.true.)
-
- return
- 10 write (iout,'(a)') 'Error reading test structure.'
- return
- end subroutine test3
-!-----------------------------------------------------------------------------
- subroutine test__
-
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTROL'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-!
-! include 'COMMON.DISTFIT'
- integer :: if(2,2),ind
- integer :: iff(nres)
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(nres) :: theta2,phi2,alph2,omeg2,&
- theta1,phi1,alph1,omeg1 !(maxres)
- real(kind=8),dimension(6*nres) :: varia,varia2 !(maxvar) (maxvar=6*maxres)
-!
- integer :: i,j,nn,ifun,iretcode,nfun
- real(kind=8) :: etot
- nn=0
-
- read (inp,*,err=10,end=10) if(1,1),if(1,2),if(2,1),if(2,2)
- write (iout,'(a4,4i5)') 'if =',if(1,1),if(1,2),if(2,1),if(2,2)
- read (inp,*,err=10,end=10) (theta2(i),i=3,nres)
- read (inp,*,err=10,end=10) (phi2(i),i=4,nres)
- read (inp,*,err=10,end=10) (alph2(i),i=2,nres-1)
- read (inp,*,err=10,end=10) (omeg2(i),i=2,nres-1)
- do i=1,nres
- theta2(i)=deg2rad*theta2(i)
- phi2(i)=deg2rad*phi2(i)
- alph2(i)=deg2rad*alph2(i)
- omeg2(i)=deg2rad*omeg2(i)
- enddo
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
- do i=1,nres
- mask(i)=1
- enddo
-
-
-!------------------------
- do i=1,nres
- iff(i)=0
- enddo
- do j=1,2
- do i=if(j,1),if(j,2)
- iff(i)=1
- enddo
- enddo
-
- call chainbuild
- call geom_to_var(nvar,varia)
- call write_pdb(1,'first structure',0d0)
-
- call secondary(.true.)
-
- call secondary2(.true.)
-
- do j=1,nbfrag
- if ( (bfrag(3,j).lt.bfrag(4,j) .or. &
- bfrag(4,j)-bfrag(2,j).gt.4) .and. &
- bfrag(2,j)-bfrag(1,j).gt.3 ) then
- nn=nn+1
-
- if (bfrag(3,j).lt.bfrag(4,j)) then
- write(iout,'(a6,i3,a1,i3,a1,i3,a1,i3)') &
- "select",bfrag(1,j)-1,"-",bfrag(2,j)-1,&
- ",",bfrag(3,j)-1,"-",bfrag(4,j)-1
- else
- write(iout,'(a6,i3,a1,i3,a1,i3,a1,i3)') &
- "select",bfrag(1,j)-1,"-",bfrag(2,j)-1,&
- ",",bfrag(4,j)-1,"-",bfrag(3,j)-1
- endif
- endif
- enddo
-
- do i=1,nres
- theta(i)=theta2(i)
- phi(i)=phi2(i)
- alph(i)=alph2(i)
- omeg(i)=omeg2(i)
- enddo
-
- call chainbuild
- call geom_to_var(nvar,varia2)
- call write_pdb(2,'second structure',0d0)
-
-
-
-!-------------------------------------------------------
-!el#ifdef MPI
- ifun=-1
- call contact_cp(varia,varia2,iff,ifun,7)
- if (minim) then
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,varia,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,&
- '+ DIST eval',ifun
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,varia)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-!el#endif
- call etotal(energy)
- etot=energy(0)
- call enerprint(energy)
- call intout
- call briefout(0,etot)
-
- return
- 10 write (iout,'(a)') 'Error reading test structure.'
- return
- end subroutine test__
-!-----------------------------------------------------------------------------
- subroutine secondary(lprint)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-
- integer :: ncont,icont(2,nres*nres/2),isec(nres,3)
- logical :: lprint,not_done
- real(kind=4) :: dcont(nres*nres/2),d
- real(kind=4) :: rcomp = 7.0
- real(kind=4) :: rbeta = 5.2
- real(kind=4) :: ralfa = 5.2
- real(kind=4) :: r310 = 6.6
- real(kind=8),dimension(3) :: xpi,xpj
- integer :: i,k,j,i1,j1,nbeta,nstrand,ii1,jj1,ij,iii1,jjj1,&
- nhelix
- call chainbuild
-!d call write_pdb(99,'sec structure',0d0)
- ncont=0
- nbfrag=0
- nhfrag=0
- do i=1,nres
- isec(i,1)=0
- isec(i,2)=0
- isec(i,3)=0
- enddo
-
- do i=2,nres-3
- do k=1,3
- xpi(k)=0.5d0*(c(k,i-1)+c(k,i))
- enddo
- do j=i+2,nres
- do k=1,3
- xpj(k)=0.5d0*(c(k,j-1)+c(k,j))
- enddo
-!d d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) +
-!d & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) +
-!d & (c(3,i)-c(3,j))*(c(3,i)-c(3,j))
-!d print *,'CA',i,j,d
- d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) + &
- (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) + &
- (xpi(3)-xpj(3))*(xpi(3)-xpj(3))
- if ( d.lt.rcomp*rcomp) then
- ncont=ncont+1
- icont(1,ncont)=i
- icont(2,ncont)=j
- dcont(ncont)=sqrt(d)
- endif
- enddo
- enddo
- if (lprint) then
- write (iout,*)
- write (iout,'(a)') '#PP contact map distances:'
- do i=1,ncont
- write (iout,'(3i4,f10.5)') &
- i,icont(1,i),icont(2,i),dcont(i)
- enddo
- endif
-
-! finding parallel beta
-!d write (iout,*) '------- looking for parallel beta -----------'
- nbeta=0
- nstrand=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and. &
- isec(i1,1).le.1.and.isec(j1,1).le.1.and. &
- (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. &
- (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. &
- (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. &
- (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) &
- ) then
- ii1=i1
- jj1=j1
-!d write (iout,*) i1,j1,dcont(i)
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) &
- .and. dcont(j).le.rbeta .and. &
- isec(i1,1).le.1.and.isec(j1,1).le.1.and. &
- (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. &
- (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. &
- (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. &
- (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) &
- ) goto 5
- enddo
- not_done=.false.
- 5 continue
-!d write (iout,*) i1,j1,dcont(j),not_done
- enddo
- j1=j1-1
- i1=i1-1
- if (i1-ii1.gt.1) then
- ii1=max0(ii1-1,1)
- jj1=max0(jj1-1,1)
- nbeta=nbeta+1
- if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=ii1
- bfrag(2,nbfrag)=i1
- bfrag(3,nbfrag)=jj1
- bfrag(4,nbfrag)=j1
-
- do ij=ii1,i1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
- do ij=jj1,j1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
-
- if(lprint) then
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-1,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-1,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nbeta.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",jj1-1,"..",j1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",jj1-1,"..",j1-1,"'"
- endif
- write(12,'(a8,4i4)') &
- "SetNeigh",ii1-1,i1-1,jj1-1,j1-1
- endif
- endif
- endif
- enddo
-
-! finding antiparallel beta
-!d write (iout,*) '--------- looking for antiparallel beta ---------'
-
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (dcont(i).le.rbeta.and. &
- isec(i1,1).le.1.and.isec(j1,1).le.1.and. &
- (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. &
- (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. &
- (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. &
- (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) &
- ) then
- ii1=i1
- jj1=j1
-!d write (iout,*) i1,j1,dcont(i)
-
- not_done=.true.
- do while (not_done)
- i1=i1+1
- j1=j1-1
- do j=1,ncont
- if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. &
- isec(i1,1).le.1.and.isec(j1,1).le.1.and. &
- (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. &
- (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. &
- (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. &
- (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) &
- .and. dcont(j).le.rbeta ) goto 6
- enddo
- not_done=.false.
- 6 continue
-!d write (iout,*) i1,j1,dcont(j),not_done
- enddo
- i1=i1-1
- j1=j1+1
- if (i1-ii1.gt.1) then
- if(lprint)write (iout,*)'antiparallel beta',&
- nbeta,ii1-1,i1,jj1,j1-1
-
- nbfrag=nbfrag+1
- bfrag(1,nbfrag)=max0(ii1-1,1)
- bfrag(2,nbfrag)=i1
- bfrag(3,nbfrag)=jj1
- bfrag(4,nbfrag)=max0(j1-1,1)
-
- nbeta=nbeta+1
- iii1=max0(ii1-1,1)
- do ij=iii1,i1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
- jjj1=max0(j1-1,1)
- do ij=jjj1,jj1
- isec(ij,1)=isec(ij,1)+1
- isec(ij,1+isec(ij,1))=nbeta
- enddo
-
-
- if (lprint) then
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-2,"..",i1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",ii1-2,"..",i1-1,"'"
- endif
- nstrand=nstrand+1
- if (nstrand.le.9) then
- write(12,'(a18,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",j1-2,"..",jj1-1,"'"
- else
- write(12,'(a18,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'strand",nstrand,&
- "' 'num = ",j1-2,"..",jj1-1,"'"
- endif
- write(12,'(a8,4i4)') &
- "SetNeigh",ii1-2,i1-1,jj1-1,j1-2
- endif
- endif
- endif
- enddo
-
- if (nstrand.gt.0.and.lprint) then
- write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1"
- do i=2,nstrand
- if (i.le.9) then
- write(12,'(a9,i1,$)') " | strand",i
- else
- write(12,'(a9,i2,$)') " | strand",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
-
-! finding alpha or 310 helix
-
- nhelix=0
- do i=1,ncont
- i1=icont(1,i)
- j1=icont(2,i)
- if (j1.eq.i1+3.and.dcont(i).le.r310 &
- .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then
-!d if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i)
-!d if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i)
- ii1=i1
- jj1=j1
- if (isec(ii1,1).eq.0) then
- not_done=.true.
- else
- not_done=.false.
- endif
- do while (not_done)
- i1=i1+1
- j1=j1+1
- do j=1,ncont
- if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10
- enddo
- not_done=.false.
- 10 continue
-!d write (iout,*) i1,j1,not_done
- enddo
- j1=j1-1
- if (j1-ii1.gt.4) then
- nhelix=nhelix+1
-!d write (iout,*)'helix',nhelix,ii1,j1
-
- nhfrag=nhfrag+1
- hfrag(1,nhfrag)=ii1
- hfrag(2,nhfrag)=max0(j1-1,1)
-
- do ij=ii1,j1
- isec(ij,1)=-1
- enddo
- if (lprint) then
- write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2
- if (nhelix.le.9) then
- write(12,'(a17,i1,a9,i3,a2,i3,a1)') &
- "DefPropRes 'helix",nhelix,&
- "' 'num = ",ii1-1,"..",j1-2,"'"
- else
- write(12,'(a17,i2,a9,i3,a2,i3,a1)') &
- "DefPropRes 'helix",nhelix,&
- "' 'num = ",ii1-1,"..",j1-2,"'"
- endif
- endif
- endif
- endif
- enddo
-
- if (nhelix.gt.0.and.lprint) then
- write(12,'(a26,$)') "DefPropRes 'helix' 'helix1"
- do i=2,nhelix
- if (nhelix.le.9) then
- write(12,'(a8,i1,$)') " | helix",i
- else
- write(12,'(a8,i2,$)') " | helix",i
- endif
- enddo
- write(12,'(a1)') "'"
- endif
-
- if (lprint) then
- write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'"
- write(12,'(a20)') "XMacStand ribbon.mac"
- endif
-
- return
- end subroutine secondary
-!-----------------------------------------------------------------------------
- subroutine contact_cp2(var,var2,iff,ieval,in_pdb)
-
- use geometry, only:dist
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.VAR'
-! include 'COMMON.CHAIN'
-! include 'COMMON.MINIM'
-
- character(len=50) :: linia
- integer :: nf,ij(4)
- real(kind=8),dimension(6*nres) :: var,var2 !(maxvar) (maxvar=6*maxres)
- real(kind=8) :: time0,time1
- integer :: iff(nres),ieval
- real(kind=8),dimension(nres) :: theta1,phi1,alph1,omeg1 !(maxres)
-
-!el local variables
- integer :: in_pdb,i,j,ind,ipot0,maxmin0,maxfun0,nfun,iwsk,iretcode
- real(kind=8) :: wstrain0,etot
- integer :: maxres22
- maxres22=nres*(nres+1)/2
-
- if(.not.allocated(DRDG)) allocate(DRDG(maxres22,maxres22)) !(MAXRES22,MAXRES)
- call var_to_geom(nvar,var)
- call chainbuild
- nhpb0=nhpb
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
- call var_to_geom(nvar,var2)
-
- do i=1,nres
- if ( iff(i).eq.1 ) then
- theta(i)=theta1(i)
- phi(i)=phi1(i)
- alph(i)=alph1(i)
- omeg(i)=omeg1(i)
- endif
- enddo
-
- call chainbuild
-!d call write_pdb(3,'combined structure',0d0)
-!d time0=MPI_WTIME()
-
- NX=NRES-3
- NY=((NRES-4)*(NRES-5))/2
- call distfit(.true.,200)
-
-!d time1=MPI_WTIME()
-!d write (iout,'(a,f6.2,a)') ' Time for distfit ',time1-time0,' sec'
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
-
- ipot=6
- maxmin=2000
- maxfun=5000
- call geom_to_var(nvar,var)
-!d time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-
-!d time1=MPI_WTIME()
-!d write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
-!d & nfun/(time1-time0),' SOFT eval/s'
- call var_to_geom(nvar,var)
- call chainbuild
-
-
- iwsk=0
- nf=0
- if (iff(1).eq.1) then
- iwsk=1
- nf=nf+1
- ij(nf)=0
- endif
- do i=2,nres
- if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
- iwsk=1
- nf=nf+1
- ij(nf)=i
- endif
- if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
- iwsk=0
- nf=nf+1
- ij(nf)=i-1
- endif
- enddo
- if (iff(nres).eq.1) then
- nf=nf+1
- ij(nf)=nres
- endif
-
-
-!d write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
-!d & "select",ij(1),"-",ij(2),
-!d & ",",ij(3),"-",ij(4)
-!d call write_pdb(in_pdb,linia,etot)
-
-
- ipot=ipot0
- maxmin=maxmin0
- maxfun=maxfun0
-!d time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
-!d write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
- ieval=nfun
-
-!d time1=MPI_WTIME()
-!d write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0,
-!d & nfun/(time1-time0),' eval/s'
-!d call var_to_geom(nvar,var)
-!d call chainbuild
-!d call write_pdb(6,'dist structure',etot)
-
-
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
- return
- end subroutine contact_cp2
-!-----------------------------------------------------------------------------
- subroutine contact_cp(var,var2,iff,ieval,in_pdb)
-
- use geometry, only:dist
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.VAR'
-! include 'COMMON.CHAIN'
-! include 'COMMON.MINIM'
-
- character(len=50) :: linia
- integer :: nf,ij(4)
- real(kind=8) :: energy(0:n_ene)
- real(kind=8),dimension(6*nres) :: var,var2 !(maxvar) (maxvar=6*maxres)
- real(kind=8) :: time0,time1
- integer :: iff(nres),ieval
- real(kind=8),dimension(nres) :: theta1,phi1,alph1,omeg1 !(maxres)
- logical :: debug
-
-!el local variables
- integer :: in_pdb,i,j,ind,iwsk
-
- debug=.false.
-! debug=.true.
- if (ieval.eq.-1) debug=.true.
-
-
-!
-! store selected dist. constrains from 1st structure
-!
-#ifdef OSF
-! Intercept NaNs in the coordinates
-! write(iout,*) (var(i),i=1,nvar)
- x_sum=0.D0
- do i=1,nvar
- x_sum=x_sum+var(i)
- enddo
- if (x_sum.ne.x_sum) then
- write(iout,*)" *** contact_cp : Found NaN in coordinates"
- call flush(iout)
- print *," *** contact_cp : Found NaN in coordinates"
- return
- endif
-#endif
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- nhpb0=nhpb
- ind=0
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- d0(ind)=DIST(i,j)
- w(ind)=10.0
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=10.0
- dhpb(nhpb)=d0(ind)
- else
- w(ind)=0.0
- endif
- enddo
- enddo
- call hpb_partition
-
- do i=1,nres
- theta1(i)=theta(i)
- phi1(i)=phi(i)
- alph1(i)=alph(i)
- omeg1(i)=omeg(i)
- enddo
-
-!
-! freeze sec.elements from 2nd structure
-!
- do i=1,nres
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- enddo
-
- call var_to_geom(nvar,var2)
- call secondary2(debug)
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask(i)=0
- mask_phi(i)=0
- mask_theta(i)=0
- enddo
- enddo
- mask_r=.true.
-
-!
-! copy selected res from 1st to 2nd structure
-!
-
- do i=1,nres
- if ( iff(i).eq.1 ) then
- theta(i)=theta1(i)
- phi(i)=phi1(i)
- alph(i)=alph1(i)
- omeg(i)=omeg1(i)
- endif
- enddo
-
- if(debug) then
-!
-! prepare description in linia variable
-!
- iwsk=0
- nf=0
- if (iff(1).eq.1) then
- iwsk=1
- nf=nf+1
- ij(nf)=1
- endif
- do i=2,nres
- if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
- iwsk=1
- nf=nf+1
- ij(nf)=i
- endif
- if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
- iwsk=0
- nf=nf+1
- ij(nf)=i-1
- endif
- enddo
- if (iff(nres).eq.1) then
- nf=nf+1
- ij(nf)=nres
- endif
-
- write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') &
- "SELECT",ij(1)-1,"-",ij(2)-1,&
- ",",ij(3)-1,"-",ij(4)-1
-
- endif
-!
-! run optimization
-!
- call contact_cp_min(var,ieval,in_pdb,linia,debug)
-
- return
- end subroutine contact_cp
-!-----------------------------------------------------------------------------
- subroutine contact_cp_min(var,ieval,in_pdb,linia,debug)
-
-!el use minim
-!
-! input : theta,phi,alph,omeg,in_pdb,linia,debug
-! output : var,ieval
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.VAR'
-! include 'COMMON.CHAIN'
-! include 'COMMON.MINIM'
-
- character(len=50) :: linia
- integer :: nf,ij(4)
- real(kind=8) :: energy(0:n_ene)
- real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
- real(kind=8) :: time0,time1
- integer :: ieval,info(3)
- logical :: debug,fail,reduce,change !check_var,
-
-!el local variables
- integer :: in_pdb,i,ipot0,ipot01,maxmin0,maxfun0,maxmin01,maxfun01,&
- iretcode,nfun
- real(kind=8) :: wsc01,wscp01,welec01,wvdwpp01,wscloc01,wtor01,&
- wtor_d01,wstrain0,etot
-
- write(iout,'(a20,i6,a20)') &
- '------------------',in_pdb,'-------------------'
-!el#ifdef MPI
- if (debug) then
- call chainbuild
- call write_pdb(1000+in_pdb,'combined structure',0d0)
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- endif
-!el#endif
-!
-! run optimization of distances
-!
-! uses d0(),w() and mask() for frozen 2D
-!
-!test---------------------------------------------
-!test NX=NRES-3
-!test NY=((NRES-4)*(NRES-5))/2
-!test call distfit(debug,5000)
-
- do i=1,nres
- mask_side(i)=0
- enddo
-
- ipot01=ipot
- maxmin01=maxmin
- maxfun01=maxfun
-! wstrain01=wstrain
- wsc01=wsc
- wscp01=wscp
- welec01=welec
- wvdwpp01=wvdwpp
-! wang01=wang
- wscloc01=wscloc
- wtor01=wtor
- wtor_d01=wtor_d
-
- ipot=6
- maxmin=2000
- maxfun=4000
-! wstrain=1.0
- wsc=0.0
- wscp=0.0
- welec=0.0
- wvdwpp=0.0
-! wang=0.0
- wscloc=0.0
- wtor=0.0
- wtor_d=0.0
-
- call geom_to_var(nvar,var)
-!de change=reduce(var)
- if (check_var(var,info)) then
- write(iout,*) 'cp_min error in input'
- print *,'cp_min error in input'
- return
- endif
-
-!d call etotal(energy(0))
-!d call enerprint(energy(0))
-!d call check_eint
-!el#ifdef MPI
- time0=MPI_WTIME()
-!dtest call minimize(etot,var,iretcode,nfun)
-!dtest write(iout,*)'SUMSL return code is',iretcode,' eval SDIST',nfun
- time1=MPI_WTIME()
-!el#endif
-!d call etotal(energy(0))
-!d call enerprint(energy(0))
-!d call check_eint
-
- do i=1,nres
- mask_side(i)=1
- enddo
-
- ipot=ipot01
- maxmin=maxmin01
- maxfun=maxfun01
-! wstrain=wstrain01
- wsc=wsc01
- wscp=wscp01
- welec=welec01
- wvdwpp=wvdwpp01
-! wang=wang01
- wscloc=wscloc01
- wtor=wtor01
- wtor_d=wtor_d01
-!test--------------------------------------------------
-
- if(debug) then
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,a)')' Time for distfit ',time1-time0,' sec'
- call write_pdb(2000+in_pdb,'distfit structure',0d0)
- endif
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
-!
-! run soft pot. optimization
-! with constrains:
-! nhpb,ihpb(),jhpb(),forcon(),dhpb() and hpb_partition
-! and frozen 2D:
-! mask_phi(),mask_theta(),mask_side(),mask_r
-!
- ipot=6
- maxmin=2000
- maxfun=4000
-!el#ifdef MPI
-!de change=reduce(var)
-!de if (check_var(var,info)) write(iout,*) 'error before soft'
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
-
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,&
- nfun/(time1-time0),' SOFT eval/s'
-
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(3000+in_pdb,'soft structure',etot)
- endif
-!el#endif
-!
-! run full UNRES optimization with constrains and frozen 2D
-! the same variables as soft pot. optimizatio
-!
- ipot=ipot0
- maxmin=maxmin0
- maxfun=maxfun0
-!
-! check overlaps before calling full UNRES minim
-!
- call var_to_geom(nvar,var)
- call chainbuild
- call etotal(energy)
-#ifdef OSF
- write(iout,*) 'N7 ',energy(0)
- if (energy(0).ne.energy(0)) then
- write(iout,*) 'N7 error - gives NaN',energy(0)
- endif
-#endif
- ieval=1
- if (energy(1).eq.1.0d20) then
- write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw=1d20',energy(1)
- call overlap_sc(fail)
- if(.not.fail) then
- call etotal(energy)
- ieval=ieval+1
- write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw after',energy(1)
- else
- mask_r=.false.
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
- return
- endif
- endif
- call flush(iout)
-!
-!dte time0=MPI_WTIME()
-!de change=reduce(var)
-!de if (check_var(var,info)) then
-!de write(iout,*) 'error before mask dist'
-!de call var_to_geom(nvar,var)
-!de call chainbuild
-!de call write_pdb(10000+in_pdb,'before mask dist',etot)
-!de endif
-!dte call minimize(etot,var,iretcode,nfun)
-!dte write(iout,*)'SUMSL MASK DIST return code is',iretcode,
-!dte & ' eval ',nfun
-!dte ieval=ieval+nfun
-!dte
-!dte time1=MPI_WTIME()
-!dte write (iout,'(a,f6.2,f8.2,a)')
-!dte & ' Time for mask dist min.',time1-time0,
-!dte & nfun/(time1-time0),' eval/s'
-!dte call flush(iout)
-!el#ifdef MPI
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(4000+in_pdb,'mask dist',etot)
- endif
-!
-! switch off freezing of 2D and
-! run full UNRES optimization with constrains
-!
- mask_r=.false.
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
-!de change=reduce(var)
-!de if (check_var(var,info)) then
-!de write(iout,*) 'error before dist'
-!de call var_to_geom(nvar,var)
-!de call chainbuild
-!de call write_pdb(11000+in_pdb,'before dist',etot)
-!de endif
-
- call minimize(etot,var,iretcode,nfun)
-
-!de change=reduce(var)
-!de if (check_var(var,info)) then
-!de write(iout,*) 'error after dist',ico
-!de call var_to_geom(nvar,var)
-!de call chainbuild
-!de call write_pdb(12000+in_pdb+ico*1000,'after dist',etot)
-!de endif
- write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
- ieval=ieval+nfun
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for dist min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
-!de call etotal(energy(0))
-!de write(iout,*) 'N7 after dist',energy(0)
- call flush(iout)
-
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(in_pdb,linia,etot)
- endif
-!el#endif
-!
-! reset constrains
-!
- nhpb= nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
- return
- end subroutine contact_cp_min
-!-----------------------------------------------------------------------------
- subroutine softreg
-
- use geometry, only:dist
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.CHAIN'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.VAR'
-! include 'COMMON.CONTROL'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-! include 'COMMON.INTERACT'
-!
-! include 'COMMON.DISTFIT'
- integer :: iff(nres)
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
-!
- logical :: debug,ltest,fail
- character(len=50) :: linia
- integer :: ieval,i,j,in_pdb,ipot0,maxmin0,maxfun0,ico,nhpb_c,&
- iretcode,nfun
- real(kind=8) :: wstrain0,wang0,etot
-!
- linia='test'
- debug=.true.
- in_pdb=0
-
-!------------------------
-!
-! freeze sec.elements
-!
- do i=1,nres
- mask_phi(i)=1
- mask_theta(i)=1
- mask_side(i)=1
- iff(i)=0
- enddo
-
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- if (bfrag(3,j).le.bfrag(4,j)) then
- do i=bfrag(3,j),bfrag(4,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- else
- do i=bfrag(4,j),bfrag(3,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- endif
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- mask_phi(i)=0
- mask_theta(i)=0
- iff(i)=1
- enddo
- enddo
- mask_r=.true.
-
-
-
- nhpb0=nhpb
-!
-! store dist. constrains
-!
- do i=1,nres-3
- do j=i+3,nres
- if ( iff(i).eq.1.and.iff(j).eq.1 ) then
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=0.1
- dhpb(nhpb)=DIST(i,j)
- endif
- enddo
- enddo
- call hpb_partition
-
- if (debug) then
- call chainbuild
- call write_pdb(100+in_pdb,'input reg. structure',0d0)
- endif
-
-
- ipot0=ipot
- maxmin0=maxmin
- maxfun0=maxfun
- wstrain0=wstrain
- wang0=wang
-!
-! run soft pot. optimization
-!
- ipot=6
- wang=3.0
- maxmin=2000
- maxfun=4000
- call geom_to_var(nvar,var)
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
-
- write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,&
- nfun/(time1-time0),' SOFT eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(300+in_pdb,'soft structure',etot)
- endif
-!
-! run full UNRES optimization with constrains and frozen 2D
-! the same variables as soft pot. optimizatio
-!
- ipot=ipot0
- wang=wang0
- maxmin=maxmin0
- maxfun=maxfun0
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL MASK DIST return code is',iretcode,&
- ' eval ',nfun
- ieval=nfun
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)') &
- ' Time for mask dist min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(400+in_pdb,'mask & dist',etot)
- endif
-!
-! switch off constrains and
-! run full UNRES optimization with frozen 2D
-!
-
-!
-! reset constrains
-!
- nhpb_c=nhpb
- nhpb=nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
-
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun
- ieval=ieval+nfun
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
-
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(500+in_pdb,'mask 2d frozen',etot)
- endif
-
- mask_r=.false.
-
-
-!
-! run full UNRES optimization with constrains and NO frozen 2D
-!
-
- nhpb=nhpb_c
- link_start=1
- link_end=nhpb
- maxfun=maxfun0/5
-
- do ico=1,5
-
- wstrain=wstrain0/ico
-
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)') &
- ' SUMSL DIST',wstrain,' return code is',iretcode,&
- ' eval ',nfun
- ieval=nfun
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)') &
- ' Time for dist min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
- if (debug) then
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(600+in_pdb+ico,'dist cons',etot)
- endif
-
- enddo
-!
- nhpb=nhpb0
- link_start=1
- link_end=nhpb
- wstrain=wstrain0
- maxfun=maxfun0
-
-
-!
- if (minim) then
-!el#ifdef MPI
- time0=MPI_WTIME()
-!el#endif
- call minimize(etot,var,iretcode,nfun)
- write(iout,*)'------------------------------------------------'
- write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,&
- '+ DIST eval',ieval
-
-!el#ifdef MPI
- time1=MPI_WTIME()
-!el#endif
- write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,&
- nfun/(time1-time0),' eval/s'
-
-
- call var_to_geom(nvar,var)
- call chainbuild
- call write_pdb(999,'full min',etot)
- endif
-!el#endif
- return
- end subroutine softreg
-!-----------------------------------------------------------------------------
- subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij)
-
- use geometry, only:dist
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CONTROL'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-! include 'COMMON.CHAIN'
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
- integer :: jdata(5),isec(nres)
-!
-!el local variables
- integer :: i1,i2,i3,i4,i5,ieval,ij
- integer :: i,j,nft_sc,ishift,iretcode,nfun,maxfun0,ico
- real(kind=8) :: etot,wscloc0,wstrain0
-
- jdata(1)=i1
- jdata(2)=i2
- jdata(3)=i3
- jdata(4)=i4
- jdata(5)=i5
-
- call secondary2(.false.)
-
- do i=1,nres
- isec(i)=0
- enddo
- do j=1,nbfrag
- do i=bfrag(1,j),bfrag(2,j)
- isec(i)=1
- enddo
- do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j))
- isec(i)=1
- enddo
- enddo
- do j=1,nhfrag
- do i=hfrag(1,j),hfrag(2,j)
- isec(i)=2
- enddo
- enddo
-
-!
-! cut strands at the ends
-!
- if (jdata(2)-jdata(1).gt.3) then
- jdata(1)=jdata(1)+1
- jdata(2)=jdata(2)-1
- if (jdata(3).lt.jdata(4)) then
- jdata(3)=jdata(3)+1
- jdata(4)=jdata(4)-1
- else
- jdata(3)=jdata(3)-1
- jdata(4)=jdata(4)+1
- endif
- endif
-
-!v call chainbuild
-!v call etotal(energy(0))
-!v etot=energy(0)
-!v write(iout,*) nnt,nct,etot
-!v call write_pdb(ij*100,'first structure',etot)
-!v write(iout,*) 'N16 test',(jdata(i),i=1,5)
-
-!------------------------
-! generate constrains
-!
- ishift=jdata(5)-2
- if(ishift.eq.0) ishift=-2
- nhpb0=nhpb
- call chainbuild
- do i=jdata(1),jdata(2)
- isec(i)=-1
- if(jdata(4).gt.jdata(3))then
- do j=jdata(3)+i-jdata(1)-2,jdata(3)+i-jdata(1)+2
- isec(j)=-1
-!d print *,i,j,j+ishift
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=1000.0
- dhpb(nhpb)=DIST(i,j+ishift)
- enddo
- else
- do j=jdata(3)-i+jdata(1)+2,jdata(3)-i+jdata(1)-2,-1
- isec(j)=-1
-!d print *,i,j,j+ishift
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=1000.0
- dhpb(nhpb)=DIST(i,j+ishift)
- enddo
- endif
- enddo
-
- do i=nnt,nct-2
- do j=i+2,nct
- if(isec(i).gt.0.or.isec(j).gt.0) then
-!d print *,i,j
- nhpb=nhpb+1
- ihpb(nhpb)=i
- jhpb(nhpb)=j
- forcon(nhpb)=0.1
- dhpb(nhpb)=DIST(i,j)
- endif
- enddo
- enddo
-
- call hpb_partition
-
- call geom_to_var(nvar,var)
- maxfun0=maxfun
- wstrain0=wstrain
- maxfun=4000/5
-
- do ico=1,5
-
- wstrain=wstrain0/ico
-
-!v time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)') &
- ' SUMSL DIST',wstrain,' return code is',iretcode,&
- ' eval ',nfun
- ieval=ieval+nfun
-!v time1=MPI_WTIME()
-!v write (iout,'(a,f6.2,f8.2,a)')
-!v & ' Time for dist min.',time1-time0,
-!v & nfun/(time1-time0),' eval/s'
-!v call var_to_geom(nvar,var)
-!v call chainbuild
-!v call write_pdb(ij*100+ico,'dist cons',etot)
-
- enddo
-!
- nhpb=nhpb0
- call hpb_partition
- wstrain=wstrain0
- maxfun=maxfun0
-!
-!d print *,etot
- wscloc0=wscloc
- wscloc=10.0
- call sc_move(nnt,nct,100,100d0,nft_sc,etot)
- wscloc=wscloc0
-!v call chainbuild
-!v call etotal(energy(0))
-!v etot=energy(0)
-!v call write_pdb(ij*100+10,'sc_move',etot)
-!d call intout
-!d print *,nft_sc,etot
-
- return
- end subroutine beta_slide
-!-----------------------------------------------------------------------------
- subroutine beta_zip(i1,i2,ieval,ij)
-
-!el use minim
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- include 'mpif.h'
-! include 'COMMON.GEO'
-! include 'COMMON.VAR'
-! include 'COMMON.INTERACT'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.CONTROL'
-! include 'COMMON.FFIELD'
-! include 'COMMON.MINIM'
-! include 'COMMON.CHAIN'
- real(kind=8) :: time0,time1
- real(kind=8) :: energy(0:n_ene),ee
- real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
- character(len=10) :: test
-!el local variables
- integer :: i1,i2,ieval,ij,ico,iretcode,nfun,maxfun0
- real(kind=8) :: etot,wstrain0
-!v call chainbuild
-!v call etotal(energy(0))
-!v etot=energy(0)
-!v write(test,'(2i5)') i1,i2
-!v call write_pdb(ij*100,test,etot)
-!v write(iout,*) 'N17 test',i1,i2,etot,ij
-
-!
-! generate constrains
-!
- nhpb0=nhpb
- nhpb=nhpb+1
- ihpb(nhpb)=i1
- jhpb(nhpb)=i2
- forcon(nhpb)=1000.0
- dhpb(nhpb)=4.0
-
- call hpb_partition
-
- call geom_to_var(nvar,var)
- maxfun0=maxfun
- wstrain0=wstrain
- maxfun=1000/5
-
- do ico=1,5
- wstrain=wstrain0/ico
-!v time0=MPI_WTIME()
- call minimize(etot,var,iretcode,nfun)
- write(iout,'(a10,f6.3,a14,i3,a6,i5)') &
- ' SUMSL DIST',wstrain,' return code is',iretcode,&
- ' eval ',nfun
- ieval=ieval+nfun
-!v time1=MPI_WTIME()
-!v write (iout,'(a,f6.2,f8.2,a)')
-!v & ' Time for dist min.',time1-time0,
-!v & nfun/(time1-time0),' eval/s'
-! do not comment the next line
- call var_to_geom(nvar,var)
-!v call chainbuild
-!v call write_pdb(ij*100+ico,'dist cons',etot)
- enddo
-
- nhpb=nhpb0
- call hpb_partition
- wstrain=wstrain0
- maxfun=maxfun0
-
-!v call etotal(energy(0))
-!v etot=energy(0)
-!v write(iout,*) 'N17 test end',i1,i2,etot,ij
-
- return
- end subroutine beta_zip
-!-----------------------------------------------------------------------------
-! thread.F
-!-----------------------------------------------------------------------------
- subroutine thread_seq
-
- use geometry, only:dist
- use random, only:iran_num
- use control, only:tcpu
- use regularize_, only:regularize
- use mcm_data, only: nsave_part,nacc_tot
-! Thread the sequence through a database of known structures
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- use MPI_data !include 'COMMON.INFO'
- use MPI_
-#ifdef MPI
- include 'mpif.h'
-#endif
-! include 'COMMON.CONTROL'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DBASE'
-! include 'COMMON.INTERACT'
-! include 'COMMON.VAR'
-! include 'COMMON.THREAD'
-! include 'COMMON.FFIELD'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.HEADER'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.TIME1'
-! include 'COMMON.CONTACTS'
-! include 'COMMON.MCM'
-! include 'COMMON.NAMES'
-#ifdef MPI
- integer :: ThreadId,ThreadType,Kwita
-#endif
- real(kind=8),dimension(6*nres) :: varia !(maxvar) (maxvar=6*maxres)
- real(kind=8) :: przes(3),obr(3,3)
- real(kind=8) :: time_for_thread
- logical :: found_pattern,non_conv
- character(len=32) :: head_pdb
- real(kind=8) :: energia(0:n_ene)
- integer :: i,j,ithread,itrial,ii,jj,nres_t,ist,ipattern,iretcode,&
- link_end0,iproc
- real(kind=8) :: dcj,rms,frac,frac_nn,co,etot,curr_tim,curr_tim1
-
- n_ene_comp=nprint_ene
-!
-! Body
-!
-#ifdef MPI
- if (me.eq.king) then
- do i=1,nctasks
- nsave_part(i)=0
- enddo
- endif
- nacc_tot=0
-
- Kwita=0
-#endif
- close(igeom)
- close(ipdb)
- close(istat)
- do i=1,maxthread
- do j=1,14
- ener0(j,i)=0.0D0
- ener(j,i)=0.0D0
- enddo
- enddo
- nres0=nct-nnt+1
- ave_time_for_thread=0.0D0
- max_time_for_thread=0.0D0
-!d print *,'nthread=',nthread,' nseq=',nseq,' nres0=',nres0
- nthread=nexcl+nthread
- do ithread=1,nthread
- found_pattern=.false.
- itrial=0
- do while (.not.found_pattern)
- itrial=itrial+1
- if (itrial.gt.1000) then
- write (iout,'(/a/)') 'Too many attempts to find pattern.'
- nthread=ithread-1
-#ifdef MPI
- call recv_stop_sig(Kwita)
- call send_stop_sig(-3)
-#endif
- goto 777
- endif
-! Find long enough chain in the database
- ii=iran_num(1,nseq)
- nres_t=nres_base(1,ii)
-! Select the starting position to thread.
- print *,'nseq',nseq,' ii=',ii,' nres_t=',&
- nres_t,' nres0=',nres0
- if (nres_t.ge.nres0) then
- ist=iran_num(0,nres_t-nres0)
-#ifdef MPI
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- if (Kwita.lt.0) then
- write (iout,*) 'Stop signal received. Terminating.'
- write (*,*) 'Stop signal received. Terminating.'
- nthread=ithread-1
- write (*,*) 'ithread=',ithread,' nthread=',nthread
- goto 777
- endif
- call pattern_receive
-#endif
- do i=1,nexcl
- if (iexam(1,i).eq.ii .and. iexam(2,i).eq.ist) goto 10
- enddo
- found_pattern=.true.
- endif
-! If this point is reached, the pattern has not yet been examined.
- 10 continue
-! print *,'found_pattern:',found_pattern
- enddo
- nexcl=nexcl+1
- iexam(1,nexcl)=ii
- iexam(2,nexcl)=ist
-#ifdef MPI
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- if (Kwita.lt.0) then
- write (iout,*) 'Stop signal received. Terminating.'
- nthread=ithread-1
- write (*,*) 'ithread=',ithread,' nthread=',nthread
- goto 777
- endif
- call pattern_send
-#endif
- ipatt(1,ithread)=ii
- ipatt(2,ithread)=ist
-#ifdef MPI
- write (iout,'(/80(1h*)/a,i4,a,i5,2a,i3,a,i3,a,i3/)') &
- 'Processor:',me,' Attempt:',ithread,&
- ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),&
- ' start at res.',ist+1
- write (*,'(a,i4,a,i5,2a,i3,a,i3,a,i3)') 'Processor:',me,&
- ' Attempt:',ithread,&
- ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),&
- ' start at res.',ist+1
-#else
- write (iout,'(/80(1h*)/a,i5,2a,i3,a,i3,a,i3/)') &
- 'Attempt:',ithread,&
- ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),&
- ' start at res.',ist+1
- write (*,'(a,i5,2a,i3,a,i3,a,i3)') &
- 'Attempt:',ithread,&
- ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii),&
- ' start at res.',ist+1
-#endif
- ipattern=ii
-! Copy coordinates from the database.
- ist=ist-(nnt-1)
- do i=nnt,nct
- do j=1,3
- c(j,i)=cart_base(j,i+ist,ii)
-! cref(j,i)=c(j,i)
- enddo
-!d write (iout,'(a,i4,3f10.5)') restyp(itype(i)),i,(c(j,i),j=1,3)
- enddo
-!d call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,
-!d non_conv)
-!d write (iout,'(a,f10.5)')
-!d & 'Initial RMS deviation from reference structure:',rms
- if (itype(nres).eq.ntyp1) then
- do j=1,3
- dcj=c(j,nres-2)-c(j,nres-3)
- c(j,nres)=c(j,nres-1)+dcj
- c(j,2*nres)=c(j,nres)
- enddo
- endif
- if (itype(1).eq.ntyp1) then
- do j=1,3
- dcj=c(j,4)-c(j,3)
- c(j,1)=c(j,2)-dcj
- c(j,nres+1)=c(j,1)
- enddo
- endif
- call int_from_cart(.false.,.false.)
-!d print *,'Exit INT_FROM_CART.'
-!d print *,'nhpb=',nhpb
- do i=nss+1,nhpb
- ii=ihpb(i)
- jj=jhpb(i)
- dhpb(i)=dist(ii,jj)
-! write (iout,'(2i5,2f10.5)') ihpb(i),jhpb(i),dhpb(i),forcon(i)
- enddo
-! stop 'End generate'
-! Generate SC conformations.
- call sc_conf
-! call intout
-#ifdef MPI
-!d print *,'Processor:',me,': exit GEN_SIDE.'
-#else
-!d print *,'Exit GEN_SIDE.'
-#endif
-! Calculate initial energy.
- call chainbuild
- call etotal(energia)
- etot=energia(0)
- do i=1,n_ene_comp
- ener0(i,ithread)=energia(i)
- enddo
- ener0(n_ene_comp+1,ithread)=energia(0)
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- ener0(n_ene_comp+3,ithread)=contact_fract(ncont,ncont_ref,&
- icont,icont_ref)
- ener0(n_ene_comp+2,ithread)=rms
- ener0(n_ene_comp+4,ithread)=frac
- ener0(n_ene_comp+5,ithread)=frac_nn
- endif
- ener0(n_ene_comp+3,ithread)=0.0d0
-! Minimize energy.
-#ifdef MPI
- print*,'Processor:',me,' ithread=',ithread,' Start REGULARIZE.'
-#else
- print*,'ithread=',ithread,' Start REGULARIZE.'
-#endif
- curr_tim=tcpu()
- call regularize(nct-nnt+1,etot,rms,&
- cart_base(1,ist+nnt,ipattern),iretcode)
- curr_tim1=tcpu()
- time_for_thread=curr_tim1-curr_tim
- ave_time_for_thread= &
- ((ithread-1)*ave_time_for_thread+time_for_thread)/ithread
- if (time_for_thread.gt.max_time_for_thread) &
- max_time_for_thread=time_for_thread
-#ifdef MPI
- print *,'Processor',me,': Exit REGULARIZE.'
- if (WhatsUp.eq.2) then
- write (iout,*) &
- 'Sufficient number of confs. collected. Terminating.'
- nthread=ithread-1
- goto 777
- else if (WhatsUp.eq.-1) then
- nthread=ithread-1
- write (iout,*) 'Time up in REGULARIZE. Call SEND_STOP_SIG.'
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- call send_stop_sig(-2)
- goto 777
- else if (WhatsUp.eq.-2) then
- nthread=ithread-1
- write (iout,*) 'Timeup signal received. Terminating.'
- goto 777
- else if (WhatsUp.eq.-3) then
- nthread=ithread-1
- write (iout,*) 'Error stop signal received. Terminating.'
- goto 777
- endif
-#else
- print *,'Exit REGULARIZE.'
- if (iretcode.eq.11) then
- write (iout,'(/a/)') &
- '******* Allocated time exceeded in SUMSL. The program will stop.'
- nthread=ithread-1
- goto 777
- endif
-#endif
- head_pdb=titel(:24)//':'//str_nam(ipattern)
- if (outpdb) call pdbout(etot,head_pdb,ipdb)
- if (outmol2) call mol2out(etot,head_pdb)
-! call intout
- call briefout(ithread,etot)
- link_end0=link_end
- link_end=min0(link_end,nss)
- write (iout,*) 'link_end=',link_end,' link_end0=',link_end0,&
- ' nss=',nss
- call etotal(energia)
-! call enerprint(energia(0))
- link_end=link_end0
-!d call chainbuild
-!d call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,non_conv)
-!d write (iout,'(a,f10.5)')
-!d & 'RMS deviation from reference structure:',dsqrt(rms)
- do i=1,n_ene_comp
- ener(i,ithread)=energia(i)
- enddo
- ener(n_ene_comp+1,ithread)=energia(0)
- ener(n_ene_comp+3,ithread)=rms
- if (refstr) then
- call rms_nac_nnc(rms,frac,frac_nn,co,.true.)
- ener(n_ene_comp+2,ithread)=rms
- ener(n_ene_comp+4,ithread)=frac
- ener(n_ene_comp+5,ithread)=frac_nn
- endif
- call write_stat_thread(ithread,ipattern,ist)
-! write (istat,'(i4,2x,a8,i4,11(1pe14.5),2(0pf8.3),f8.5)')
-! & ithread,str_nam(ipattern),ist+1,(ener(k,ithread),k=1,11),
-! & (ener(k,ithread),k=12,14)
-#ifdef MPI
- if (me.eq.king) then
- nacc_tot=nacc_tot+1
- call pattern_receive
- call receive_MCM_info
- if (nacc_tot.ge.nthread) then
- write (iout,*) &
- 'Sufficient number of conformations collected nacc_tot=',&
- nacc_tot,'. Stopping other processors and terminating.'
- write (*,*) &
- 'Sufficient number of conformations collected nacc_tot=',&
- nacc_tot,'. Stopping other processors and terminating.'
- call recv_stop_sig(Kwita)
- if (Kwita.eq.0) call send_stop_sig(-1)
- nthread=ithread
- goto 777
- endif
- else
- call send_MCM_info(2)
- endif
-#endif
- if (timlim-curr_tim1-safety .lt. max_time_for_thread) then
- write (iout,'(/2a)') &
- '********** There would be not enough time for another thread. ',&
- 'The program will stop.'
- write (*,'(/2a)') &
- '********** There would be not enough time for another thread. ',&
- 'The program will stop.'
- write (iout,'(a,1pe14.4/)') &
- 'Elapsed time for last threading step: ',time_for_thread
- nthread=ithread
-#ifdef MPI
- call recv_stop_sig(Kwita)
- call send_stop_sig(-2)
-#endif
- goto 777
- else
- curr_tim=curr_tim1
- write (iout,'(a,1pe14.4)') &
- 'Elapsed time for this threading step: ',time_for_thread
- endif
-#ifdef MPI
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
- if (Kwita.lt.0) then
- write (iout,*) 'Stop signal received. Terminating.'
- write (*,*) 'Stop signal received. Terminating.'
- nthread=ithread
- write (*,*) 'nthread=',nthread,' ithread=',ithread
- goto 777
- endif
-#endif
- enddo
-#ifdef MPI
- call send_stop_sig(-1)
-#endif
- 777 continue
-#ifdef MPI
-! Any messages left for me?
- call pattern_receive
- if (Kwita.eq.0) call recv_stop_sig(Kwita)
-#endif
- call write_thread_summary
-#ifdef MPI
- if (king.eq.king) then
- Kwita=1
- do while (Kwita.ne.0 .or. nacc_tot.ne.0)
- Kwita=0
- nacc_tot=0
- call recv_stop_sig(Kwita)
- call receive_MCM_info
- enddo
- do iproc=1,nprocs-1
- call receive_thread_results(iproc)
- enddo
- call write_thread_summary
- else
- call send_thread_results
- endif
-#endif
- return
- end subroutine thread_seq
-!-----------------------------------------------------------------------------
- subroutine sc_conf
-
-! Sample (hopefully) optimal SC orientations given backcone conformation.
-!el use comm_srutu
- use random, only:iran_num
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DBASE'
-! include 'COMMON.INTERACT'
-! include 'COMMON.VAR'
-! include 'COMMON.THREAD'
-! include 'COMMON.FFIELD'
-! include 'COMMON.SBRIDGE'
-! include 'COMMON.HEADER'
-! include 'COMMON.GEO'
-! include 'COMMON.IOUNITS'
- real(kind=8),dimension(6*nres) :: varia !(maxvar) (maxvar=6*maxres)
-!el integer :: icall
-!el common /srutu/ icall
- real(kind=8) :: energia(0:n_ene)
- logical :: glycine,fail
- integer :: i,maxsample,link_end0,ind_sc,isample
- real(kind=8) :: alph0,omeg0,e1,e0
-
- maxsample=10
- link_end0=link_end
- link_end=min0(link_end,nss)
- do i=nnt,nct
- if (itype(i).ne.10) then
-!d print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1)
- call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail)
- endif
- enddo
- call chainbuild
- call etotal(energia)
- e0 = energia(0)
- do isample=1,maxsample
-! Choose a non-glycine side chain.
- glycine=.true.
- do while(glycine)
- ind_sc=iran_num(nnt,nct)
- glycine=(itype(ind_sc).eq.10)
- enddo
- alph0=alph(ind_sc)
- omeg0=omeg(ind_sc)
- call gen_side(itype(ind_sc),theta(ind_sc+1),alph(ind_sc),&
- omeg(ind_sc),fail)
- call chainbuild
- call etotal(energia)
-!d write (iout,'(a,i5,a,i4,2(a,f8.3),2(a,1pe14.5))')
-!d & 'Step:',isample,' SC',ind_sc,' alpha',alph(ind_sc)*rad2deg,
-!d & ' omega',omeg(ind_sc)*rad2deg,' old energy',e0,' new energy',e1
- e1=energia(0)
- if (e0.le.e1) then
- alph(ind_sc)=alph0
- omeg(ind_sc)=omeg0
- else
- e0=e1
- endif
- enddo
- link_end=link_end0
- return
- end subroutine sc_conf
-!-----------------------------------------------------------------------------
-! minim_jlee.F
-!-----------------------------------------------------------------------------
- logical function check_var(var,info)
-
- use MPI_data
- use geometry_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.VAR'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.GEO'
-! include 'COMMON.SETUP'
- real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
- integer,dimension(3) :: info
- integer :: i,j
-! AL -------
- check_var=.false.
- do i=nphi+ntheta+1,nphi+ntheta+nside
-! Check the side chain "valence" angles alpha
- if (var(i).lt.1.0d-7) then
- write (iout,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!'
- write (iout,*) 'Processor',me,'received bad variables!!!!'
- write (iout,*) 'Variables'
- write (iout,'(8f10.4)') (rad2deg*var(j),j=1,nvar)
- write (iout,*) 'Continuing calculations at this point',&
- ' could destroy the results obtained so far... ABORTING!!!!!!'
- write (iout,'(a19,i5,f10.4,a4,2i4,a3,i3)') &
- 'valence angle alpha',i-nphi-ntheta,var(i),&
- 'n it',info(1),info(2),'mv ',info(3)
- write (*,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!'
- write (*,*) 'Processor',me,'received bad variables!!!!'
- write (*,*) 'Variables'
- write (*,'(8f10.4)') (rad2deg*var(j),j=1,nvar)
- write (*,*) 'Continuing calculations at this point',&
- ' could destroy the results obtained so far... ABORTING!!!!!!'
- write (*,'(a19,i5,f10.4,a4,2i4,a3,i3)') &
- 'valence angle alpha',i-nphi-ntheta,var(i),&
- 'n it',info(1),info(2),'mv ',info(3)
- check_var=.true.
- return
- endif
- enddo
-! Check the backbone "valence" angles theta
- do i=nphi+1,nphi+ntheta
- if (var(i).lt.1.0d-7) then
- write (iout,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!'
- write (iout,*) 'Processor',me,'received bad variables!!!!'
- write (iout,*) 'Variables'
- write (iout,'(8f10.4)') (rad2deg*var(j),j=1,nvar)
- write (iout,*) 'Continuing calculations at this point',&
- ' could destroy the results obtained so far... ABORTING!!!!!!'
- write (iout,'(a19,i5,f10.4,a4,2i4,a3,i3)') &
- 'valence angle theta',i-nphi,var(i),&
- 'n it',info(1),info(2),'mv ',info(3)
- write (*,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!'
- write (*,*) 'Processor',me,'received bad variables!!!!'
- write (*,*) 'Variables'
- write (*,'(8f10.4)') (rad2deg*var(j),j=1,nvar)
- write (*,*) 'Continuing calculations at this point',&
- ' could destroy the results obtained so far... ABORTING!!!!!!'
- write (*,'(a19,i5,f10.4,a4,2i4,a3,i3)') &
- 'valence angle theta',i-nphi,var(i),&
- 'n it',info(1),info(2),'mv ',info(3)
- check_var=.true.
- return
- endif
- enddo
- return
- end function check_var
-!-----------------------------------------------------------------------------
-! distfit.f
-!-----------------------------------------------------------------------------
- subroutine distfit(debug,maxit)
-
- use geometry_data, only: phi
- use compare_data
- use md_calc
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.VAR'
-! include 'COMMON.IOUNITS'
-! include 'COMMON.DISTFIT'
- integer :: i,maxit,MAXMAR,IT,IMAR
- real(kind=8),DIMENSION(nres) :: X,DIAGH,phiold !(maxres)
- logical :: debug,sing
- real(kind=8) :: TOL,RL,F0,AIN,F1
-
-!input------------------------------------
-! NX=NRES-3
-! NY=((NRES-4)*(NRES-5))/2
-!input------------------------------------
-!test MAXIT=20
- TOL=0.5
- MAXMAR=10
- RL=100.0
-
- CALL TRANSFER(NRES,phi,phiold)
-
- F0=RDIF()
-
-!d WRITE (IOUT,*) 'DISTFIT: F0=',F0
-
-
- DO IT=1,MAXIT
- CALL RDERIV
- CALL HEVAL
-
- DO I=1,NX
- DIAGH(I)=H(I,I)
- ENDDO
- RL=RL*0.1
-
- DO IMAR=1,MAXMAR
- DO I=1,NX
- H(I,I)=DIAGH(I)+RL
- ENDDO
- CALL TRANSFER(NX,XX,X)
- CALL BANACH(NX,NRES,H,X,sing)
- AIN=0.0
- DO I=1,NX
- AIN=AIN+DABS(X(I))
- ENDDO
- IF (AIN.LT.0.1*TOL .AND. RL.LT.1.0E-4) THEN
- if (debug) then
- WRITE (IOUT,*) 'DISTFIT: CONVERGENCE HAS BEEN ACHIEVED'
- WRITE (IOUT,*) 'IT=',it,'F=',F0
- endif
- RETURN
- ENDIF
- DO I=4,NRES
- phi(I)=phiold(I)+mask(i)*X(I-3)
-! print *,X(I-3)
- ENDDO
-
- F1=RDIF()
-!d WRITE (IOUT,*) 'IMAR=',IMAR,' RL=',RL,' F1=',F1
- IF (F1.LT.F0) THEN
- CALL TRANSFER(NRES,phi,phiold)
- F0=F1
- GOTO 1
- ELSE IF (DABS(F1-F0).LT.1.0E-5) THEN
- if (debug) then
- WRITE (IOUT,*) 'DISTFIT: CANNOT IMPROVE DISTANCE FIT'
- WRITE (IOUT,*) 'IT=',it,'F=',F1
- endif
- RETURN
- ENDIF
- RL=RL*10.0
- ENDDO
- WRITE (IOUT,*) 'DISTFIT: MARQUARDT PROCEDURE HAS FAILED'
- WRITE (IOUT,*) 'IT=',it,'F=',F0
- CALL TRANSFER(NRES,phiold,phi)
- RETURN
- 1 continue
-!d write (iout,*) "it",it," imar",imar," f0",f0
- enddo
- WRITE (IOUT,*) 'DISTFIT: FINAL F=',F0,'after MAXIT=',maxit
- return
- end subroutine distfit
-!-----------------------------------------------------------------------------
- real(kind=8) function RDIF()
-
- use compare_data
- use geometry, only: dist
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DISTFIT'
- integer :: i,j,ind
- real(kind=8) :: suma,DIJ
-! print *,'in rdif'
-
- suma=0.0
- ind=0
- call chainbuild
- do i=1,nres-3
- do j=i+3,nres
- ind=ind+1
- if (w(ind).ne.0.0) then
- DIJ=DIST(i,j)
- suma=suma+w(ind)*(DIJ-d0(ind))*(DIJ-d0(ind))
- DDD(ind)=DIJ
-! print '(2i3,i4,4f12.2)',i,j,ind,dij,d0(ind),w(ind),suma
- endif
- enddo
- enddo
-
- RDIF=suma
- return
- end function RDIF
-!-----------------------------------------------------------------------------
- subroutine RDERIV
-
- use compare_data
- use geometry_data
- use geometry, only:dist
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DISTFIT'
-! include 'COMMON.GEO'
- integer :: i,j,k,l,I1,I2,IND
- real(kind=8),DIMENSION(3) :: E12,R13,R24,PRODU
-
- DO I=1,NY
- DO J=1,NX
- DRDG(I,J)=0.0
- ENDDO
- ENDDO
- DO I=1,NX
- I1=I+1
- I2=I+2
- CALL VEC(I1,I2,E12)
- DO J=1,I
- DO K=1,3
- R13(K)=C(K,J)-C(K,I1)
- ENDDO
- DO K=I2+1,NRES
- DO L=1,3
- R24(L)=C(L,K)-C(L,I2)
- ENDDO
- IND=((J-1)*(2*NRES-J-6))/2+K-3
- PRODU(1)=R13(2)*R24(3)-R13(3)*R24(2)
- PRODU(2)=R13(3)*R24(1)-R13(1)*R24(3)
- PRODU(3)=R13(1)*R24(2)-R13(2)*R24(1)
- DRDG(IND,I)=SCALAR(E12,PRODU)/DIST(J,K)
- ENDDO
- ENDDO
- ENDDO
- return
- end subroutine RDERIV
-!-----------------------------------------------------------------------------
- subroutine HEVAL
-
- use compare_data
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
-! include 'COMMON.DISTFIT'
- integer :: i,k,j
- real(kind=8) :: XI,HII,BKI,BKIWK,HIJ
-
- DO I=1,NX
- XI=0.0
- HII=0.0
- DO K=1,NY
- BKI=DRDG(K,I)
- BKIWK=w(K)*BKI
- XI=XI+BKIWK*(D0(K)-DDD(K))
- HII=HII+BKI*BKIWK
- ENDDO
- H(I,I)=HII
- XX(I)=XI
- DO J=I+1,NX
- HIJ=0.0
- DO K=1,NY
- HIJ=HIJ+DRDG(K,I)*DRDG(K,J)*w(K)
- ENDDO
- H(I,J)=HIJ
- H(J,I)=HIJ
- ENDDO
- ENDDO
- return
- end subroutine HEVAL
-!-----------------------------------------------------------------------------
- subroutine VEC(I,J,U)
-!
- use geometry_data, only: C
-! Find the unit vector from atom (I) to atom (J). Store in U.
-!
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
-! include 'COMMON.CHAIN'
- integer :: I,J,K
- real(kind=8),DIMENSION(3) :: U
- real(kind=8) :: ANORM,UK
-
- ANORM=0.0
- DO K=1,3
- UK=C(K,J)-C(K,I)
- ANORM=ANORM+UK*UK
- U(K)=UK
- ENDDO
- ANORM=SQRT(ANORM)
- DO K=1,3
- U(K)=U(K)/ANORM
- ENDDO
- return
- end subroutine VEC
-!-----------------------------------------------------------------------------
- subroutine TRANSFER(N,X1,X2)
-
-! implicit real*8 (a-h,o-z)
-! include 'DIMENSIONS'
- integer :: N,I
- real(kind=8),DIMENSION(N) :: X1,X2
- DO 1 I=1,N
- 1 X2(I)=X1(I)
- return
- end subroutine TRANSFER
-!-----------------------------------------------------------------------------
-!-----------------------------------------------------------------------------
- subroutine alloc_compare_arrays
-
- maxres22=nres*(nres+1)/2
-! common.dbase
-! common /struct/ in io_common: read_threadbase
-! allocate(cart_base !(3,maxres_base,maxseq)
-! allocate(nres_base !(3,maxseq)
-! allocate(str_nam !(maxseq)
-! common.distfit
-! COMMON /c_frag/ in io_conf: readpdb
- if(.not.allocated(bfrag)) allocate(bfrag(4,nres/3)) !(4,maxres/3)
- if(.not.allocated(hfrag)) allocate(hfrag(2,nres/3)) !(2,maxres/3)
-! COMMON /WAGI/
- allocate(w(maxres22),d0(maxres22)) !(maxres22)
-! COMMON /POCHODNE/
-!el allocate(DRDG(maxres22,maxres22)) !(MAXRES22,MAXRES)
- allocate(DDD(maxres22)) !(maxres22)
- allocate(H(nres,nres)) !(MAXRES,MAXRES)
- allocate(XX(nres)) !(MAXRES)
-! COMMON /frozen/
- allocate(mask(nres)) !(maxres)
-! common.thread
-! common /thread/
- allocate(iexam(2,maxthread),ipatt(2,maxthread)) !(2,maxthread)
-! common /thread1/
- allocate(ener0(n_ene+2,maxthread),ener(n_ene+2,maxthread)) !(n_ene+2,maxthread)
-
- return
- end subroutine alloc_compare_arrays
-!-----------------------------------------------------------------------------
-#endif
-!-----------------------------------------------------------------------------
- end module compare
projects / unres4.git / blobdiff