--- /dev/null
+ subroutine test
+ 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'
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision var(maxvar),var1(maxvar)
+ integer j1,j2
+ logical debug,accepted
+ debug=.true.
+
+
+ call geom_to_var(nvar,var1)
+ call chainbuild
+ call etotal(energy(0))
+ 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)
+c phi(jr)=pinorm(phi(jr)+d)
+ call chainbuild
+ call etotal(energy(0))
+ 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(0))
+ 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.
+c 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)
+c minimize
+c 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)
+c --------
+ else
+ phi(jr)=phiold
+ endif
+ enddo
+
+c minimize
+c call sc_move(2,nres-1,1,10d0,nft_sc,etot)
+c call geom_to_var(nvar,var)
+c
+c call chainbuild
+c call write_pdb(998 ,'sc min',etot)
+c
+c call minimize(etot,var,iretcode,nfun)
+c write(iout,*)'------------------------------------------------'
+c write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun
+c
+c call var_to_geom(nvar,var)
+c call chainbuild
+c call write_pdb(999,'full min',etot)
+
+
+ return
+ end
+
+
+ subroutine test_n16
+ 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'
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision var(maxvar),var1(maxvar)
+ integer jdata(5)
+ logical debug
+ debug=.true.
+
+c
+ call geom_to_var(nvar,var1)
+ call chainbuild
+ call etotal(energy(0))
+ 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
+ time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+ write(iout,*)'------------------------------------------------'
+ write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
+ & '+ DIST eval',ieval
+
+ time1=MPI_WTIME()
+ 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_local
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.GEO'
+ include 'COMMON.VAR'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision varia(maxvar)
+c
+ call chainbuild
+c call geom_to_var(nvar,varia)
+ call write_pdb(1,'first structure',0d0)
+
+ call etotal(energy(0))
+ 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_sc
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.GEO'
+ include 'COMMON.VAR'
+ include 'COMMON.INTERACT'
+ include 'COMMON.IOUNITS'
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision varia(maxvar)
+c
+ call chainbuild
+c call geom_to_var(nvar,varia)
+ call write_pdb(1,'first structure',0d0)
+
+ call etotal(energy(0))
+ 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
+c--------------------------------------------------------
+ subroutine bgrow(bstrand,nbstrand,in,ind,new)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.CHAIN'
+ integer bstrand(maxres/3,6)
+
+ 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
+
+
+c------------------------------------------
+ subroutine test11
+ 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'
+c
+ include 'COMMON.DISTFIT'
+ integer if(20,maxres),nif,ifa(20)
+ integer ibc(0:maxres,0:maxres),istrand(20)
+ integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0
+ integer itmp(20,maxres)
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision varia(maxvar),vorg(maxvar)
+c
+ logical debug,ltest,usedbfrag(maxres/3)
+ character*50 linia
+c
+ integer betasheet(maxres),ibetasheet(maxres),nbetasheet
+ integer bstrand(maxres/3,6),nbstrand
+
+c------------------------
+
+ debug=.true.
+c------------------------
+ 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
+c
+ 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
+c
+ 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
+
+c------------------------
+ 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
+
+c read (inp,*) (ifa(i),i=1,4)
+c do i=1,nres
+c read (inp,*,err=20,end=20) (if(j,i),j=1,4)
+c enddo
+c 20 nif=i-1
+ stop
+c------------------------
+
+ isa=4
+ is=2*isa-1
+ iconf=0
+cccccccccccccccccccccccccccccccccc
+ DO ig=1,is**isa-1
+cccccccccccccccccccccccccccccccccc
+
+ 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
+c ifa(1),ifa(2),ifa(3),ifa(4)
+c 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
+c
+ 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
+c------------------------
+
+c
+c freeze sec.elements
+c
+ 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.
+
+c------------------------
+c generate constrains
+c
+ 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
+ dd(ind)=d0(ind)
+ enddo
+ enddo
+ call hpb_partition
+cd--------------------------
+
+ 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)
+
+cd nhpb=0
+cd goto 901
+c
+c
+ call contact_cp_min(varia,ifun,iconf,linia,debug)
+ if (minim) then
+ time0=MPI_WTIME()
+ call minimize(etot,varia,iretcode,nfun)
+ write(iout,*)'------------------------------------------------'
+ write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
+ & '+ DIST eval',ifun
+
+ time1=MPI_WTIME()
+ 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
+
+ call etotal(energy(0))
+ etot=energy(0)
+ call enerprint(energy(0))
+cd call intout
+cd call briefout(0,etot)
+cd call secondary2(.true.)
+
+ 901 CONTINUE
+ctest return
+cccccccccccccccccccccccccccccccccccc
+ ENDIF
+ ENDDO
+cccccccccccccccccccccccccccccccccccc
+
+ return
+ 10 write (iout,'(a)') 'Error reading test structure.'
+ return
+ end
+c--------------------------------------------------------
+
+ subroutine test3
+ 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'
+c
+ include 'COMMON.DISTFIT'
+ integer if(3,maxres),nif
+ integer ibc(maxres,maxres),istrand(20)
+ integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision varia(maxvar)
+c
+ logical debug,ltest
+ character*50 linia
+c
+ 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)
+
+
+c------------------------
+ call secondary2(debug)
+c------------------------
+ do i=1,nres
+ do j=1,nres
+ ibc(i,j)=0
+ enddo
+ enddo
+
+c
+c freeze sec.elements and store indexes for beta constrains
+c
+ 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.
+
+
+c ---------------- 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
+c------------------------
+ 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
+
+cd--------------------------
+ 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
+c
+ call contact_cp_min(varia,ieval,in_pdb,linia,debug)
+ if (minim) then
+ time0=MPI_WTIME()
+ call minimize(etot,varia,iretcode,nfun)
+ write(iout,*)'------------------------------------------------'
+ write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
+ & '+ DIST eval',ieval
+
+ time1=MPI_WTIME()
+ 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
+
+ call etotal(energy(0))
+ etot=energy(0)
+ call enerprint(energy(0))
+ call intout
+ call briefout(0,etot)
+ call secondary2(.true.)
+
+ return
+ 10 write (iout,'(a)') 'Error reading test structure.'
+ return
+ end
+
+
+
+
+ subroutine test__
+ 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'
+c
+ include 'COMMON.DISTFIT'
+ integer if(2,2),ind
+ integer iff(maxres)
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision theta2(maxres),phi2(maxres),alph2(maxres),
+ & omeg2(maxres),
+ & theta1(maxres),phi1(maxres),alph1(maxres),
+ & omeg1(maxres)
+ double precision varia(maxvar),varia2(maxvar)
+c
+
+
+ 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
+
+
+c------------------------
+ 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)
+
+
+
+c-------------------------------------------------------
+
+ ifun=-1
+ call contact_cp(varia,varia2,iff,ifun,7)
+ if (minim) then
+ time0=MPI_WTIME()
+ call minimize(etot,varia,iretcode,nfun)
+ write(iout,*)'------------------------------------------------'
+ write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
+ & '+ DIST eval',ifun
+
+ time1=MPI_WTIME()
+ 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
+
+ call etotal(energy(0))
+ etot=energy(0)
+ call enerprint(energy(0))
+ call intout
+ call briefout(0,etot)
+
+ return
+ 10 write (iout,'(a)') 'Error reading test structure.'
+ return
+ end
+
+c-------------------------------------------------
+c-------------------------------------------------
+
+ 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,maxres*maxres/2),isec(maxres,3)
+ logical lprint,not_done
+ real dcont(maxres*maxres/2),d
+ real rcomp /7.0/
+ real rbeta /5.2/
+ real ralfa /5.2/
+ real r310 /6.6/
+ double precision xpi(3),xpj(3)
+
+
+
+ call chainbuild
+cd 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
+cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) +
+cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) +
+cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j))
+cd 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
+
+c finding parallel beta
+cd 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
+cd 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
+cd 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
+
+c finding antiparallel beta
+cd 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
+cd 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
+cd 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
+
+
+c 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
+cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i)
+cd 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
+cd write (iout,*) i1,j1,not_done
+ enddo
+ j1=j1-1
+ if (j1-ii1.gt.4) then
+ nhelix=nhelix+1
+cd 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
+c----------------------------------------------------------------------------
+
+ subroutine write_pdb(npdb,titelloc,ee)
+ implicit real*8 (a-h,o-z)
+ include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
+ character*50 titelloc1
+ character*(*) titelloc
+ character*3 zahl
+ character*5 liczba5
+ double precision ee
+ integer npdb,ilen
+ external ilen
+
+ titelloc1=titelloc
+ lenpre=ilen(prefix)
+ if (npdb.lt.1000) then
+ call numstr(npdb,zahl)
+ open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
+ else
+ if (npdb.lt.10000) then
+ write(liczba5,'(i1,i4)') 0,npdb
+ else
+ write(liczba5,'(i5)') npdb
+ endif
+ open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
+ endif
+ call pdbout(ee,titelloc1,ipdb)
+ close(ipdb)
+ return
+ end
+
+c-----------------------------------------------------------
+ subroutine contact_cp2(var,var2,iff,ieval,in_pdb)
+ 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*50 linia
+ integer nf,ij(4)
+ double precision var(maxvar),var2(maxvar)
+ double precision time0,time1
+ integer iff(maxres),ieval
+ double precision theta1(maxres),phi1(maxres),alph1(maxres),
+ & omeg1(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
+cd call write_pdb(3,'combined structure',0d0)
+cd time0=MPI_WTIME()
+
+ NX=NRES-3
+ NY=((NRES-4)*(NRES-5))/2
+ call distfit(.true.,200)
+
+cd time1=MPI_WTIME()
+cd 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)
+cd time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+ write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
+
+cd time1=MPI_WTIME()
+cd write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
+cd & 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
+
+
+cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
+cd & "select",ij(1),"-",ij(2),
+cd & ",",ij(3),"-",ij(4)
+cd call write_pdb(in_pdb,linia,etot)
+
+
+ ipot=ipot0
+ maxmin=maxmin0
+ maxfun=maxfun0
+cd time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+cd write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
+ ieval=nfun
+
+cd time1=MPI_WTIME()
+cd write (iout,'(a,f6.2,f8.2,a)')' Time for DIST min.',time1-time0,
+cd & nfun/(time1-time0),' eval/s'
+cd call var_to_geom(nvar,var)
+cd call chainbuild
+cd call write_pdb(6,'dist structure',etot)
+
+
+ nhpb= nhpb0
+ link_start=1
+ link_end=nhpb
+ wstrain=wstrain0
+
+ return
+ end
+c-----------------------------------------------------------
+ subroutine contact_cp(var,var2,iff,ieval,in_pdb)
+ 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*50 linia
+ integer nf,ij(4)
+ double precision energy(0:n_ene)
+ double precision var(maxvar),var2(maxvar)
+ double precision time0,time1
+ integer iff(maxres),ieval
+ double precision theta1(maxres),phi1(maxres),alph1(maxres),
+ & omeg1(maxres)
+ logical debug
+
+ debug=.false.
+c debug=.true.
+ if (ieval.eq.-1) debug=.true.
+
+
+c
+c store selected dist. constrains from 1st structure
+c
+#ifdef OSF
+c Intercept NaNs in the coordinates
+c 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
+
+c
+c freeze sec.elements from 2nd structure
+c
+ 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.
+
+c
+c copy selected res from 1st to 2nd structure
+c
+
+ 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
+c
+c prepare description in linia variable
+c
+ 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
+c
+c run optimization
+c
+ call contact_cp_min(var,ieval,in_pdb,linia,debug)
+
+ return
+ end
+
+ subroutine contact_cp_min(var,ieval,in_pdb,linia,debug)
+c
+c input : theta,phi,alph,omeg,in_pdb,linia,debug
+c output : var,ieval
+c
+ 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*50 linia
+ integer nf,ij(4)
+ double precision energy(0:n_ene)
+ double precision var(maxvar)
+ double precision time0,time1
+ integer ieval,info(3)
+ logical debug,fail,check_var,reduce,change
+
+ write(iout,'(a20,i6,a20)')
+ & '------------------',in_pdb,'-------------------'
+
+ if (debug) then
+ call chainbuild
+ call write_pdb(1000+in_pdb,'combined structure',0d0)
+ time0=MPI_WTIME()
+ endif
+
+c
+c run optimization of distances
+c
+c uses d0(),w() and mask() for frozen 2D
+c
+ctest---------------------------------------------
+ctest NX=NRES-3
+ctest NY=((NRES-4)*(NRES-5))/2
+ctest call distfit(debug,5000)
+
+ do i=1,nres
+ mask_side(i)=0
+ enddo
+
+ ipot01=ipot
+ maxmin01=maxmin
+ maxfun01=maxfun
+c wstrain01=wstrain
+ wsc01=wsc
+ wscp01=wscp
+ welec01=welec
+ wvdwpp01=wvdwpp
+c wang01=wang
+ wscloc01=wscloc
+ wtor01=wtor
+ wtor_d01=wtor_d
+
+ ipot=6
+ maxmin=2000
+ maxfun=4000
+c wstrain=1.0
+ wsc=0.0
+ wscp=0.0
+ welec=0.0
+ wvdwpp=0.0
+c wang=0.0
+ wscloc=0.0
+ wtor=0.0
+ wtor_d=0.0
+
+ call geom_to_var(nvar,var)
+cde change=reduce(var)
+ if (check_var(var,info)) then
+ write(iout,*) 'cp_min error in input'
+ print *,'cp_min error in input'
+ return
+ endif
+
+cd call etotal(energy(0))
+cd call enerprint(energy(0))
+cd call check_eint
+
+ time0=MPI_WTIME()
+cdtest call minimize(etot,var,iretcode,nfun)
+cdtest write(iout,*)'SUMSL return code is',iretcode,' eval SDIST',nfun
+ time1=MPI_WTIME()
+
+cd call etotal(energy(0))
+cd call enerprint(energy(0))
+cd call check_eint
+
+ do i=1,nres
+ mask_side(i)=1
+ enddo
+
+ ipot=ipot01
+ maxmin=maxmin01
+ maxfun=maxfun01
+c wstrain=wstrain01
+ wsc=wsc01
+ wscp=wscp01
+ welec=welec01
+ wvdwpp=wvdwpp01
+c wang=wang01
+ wscloc=wscloc01
+ wtor=wtor01
+ wtor_d=wtor_d01
+ctest--------------------------------------------------
+
+ if(debug) then
+ time1=MPI_WTIME()
+ 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
+c
+c run soft pot. optimization
+c with constrains:
+c nhpb,ihpb(),jhpb(),forcon(),dhpb() and hpb_partition
+c and frozen 2D:
+c mask_phi(),mask_theta(),mask_side(),mask_r
+c
+ ipot=6
+ maxmin=2000
+ maxfun=4000
+
+cde change=reduce(var)
+cde if (check_var(var,info)) write(iout,*) 'error before soft'
+ time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+
+ write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
+ time1=MPI_WTIME()
+ 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
+c
+c run full UNRES optimization with constrains and frozen 2D
+c the same variables as soft pot. optimizatio
+c
+ ipot=ipot0
+ maxmin=maxmin0
+ maxfun=maxfun0
+c
+c check overlaps before calling full UNRES minim
+c
+ call var_to_geom(nvar,var)
+ call chainbuild
+ call etotal(energy(0))
+#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(0))
+ 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)
+c
+cdte time0=MPI_WTIME()
+cde change=reduce(var)
+cde if (check_var(var,info)) then
+cde write(iout,*) 'error before mask dist'
+cde call var_to_geom(nvar,var)
+cde call chainbuild
+cde call write_pdb(10000+in_pdb,'before mask dist',etot)
+cde endif
+cdte call minimize(etot,var,iretcode,nfun)
+cdte write(iout,*)'SUMSL MASK DIST return code is',iretcode,
+cdte & ' eval ',nfun
+cdte ieval=ieval+nfun
+cdte
+cdte time1=MPI_WTIME()
+cdte write (iout,'(a,f6.2,f8.2,a)')
+cdte & ' Time for mask dist min.',time1-time0,
+cdte & nfun/(time1-time0),' eval/s'
+cdte call flush(iout)
+ if (debug) then
+ call var_to_geom(nvar,var)
+ call chainbuild
+ call write_pdb(4000+in_pdb,'mask dist',etot)
+ endif
+c
+c switch off freezing of 2D and
+c run full UNRES optimization with constrains
+c
+ mask_r=.false.
+ time0=MPI_WTIME()
+cde change=reduce(var)
+cde if (check_var(var,info)) then
+cde write(iout,*) 'error before dist'
+cde call var_to_geom(nvar,var)
+cde call chainbuild
+cde call write_pdb(11000+in_pdb,'before dist',etot)
+cde endif
+
+ call minimize(etot,var,iretcode,nfun)
+
+cde change=reduce(var)
+cde if (check_var(var,info)) then
+cde write(iout,*) 'error after dist',ico
+cde call var_to_geom(nvar,var)
+cde call chainbuild
+cde call write_pdb(12000+in_pdb+ico*1000,'after dist',etot)
+cde endif
+ write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
+ ieval=ieval+nfun
+
+ time1=MPI_WTIME()
+ write (iout,'(a,f6.2,f8.2,a)')' Time for dist min.',time1-time0,
+ & nfun/(time1-time0),' eval/s'
+cde call etotal(energy(0))
+cde 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
+c
+c reset constrains
+c
+ nhpb= nhpb0
+ link_start=1
+ link_end=nhpb
+ wstrain=wstrain0
+
+ return
+ end
+c--------------------------------------------------------
+ subroutine softreg
+ 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'
+c
+ include 'COMMON.DISTFIT'
+ integer iff(maxres)
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision var(maxvar)
+ integer ieval
+c
+ logical debug,ltest,fail
+ character*50 linia
+c
+ linia='test'
+ debug=.true.
+ in_pdb=0
+
+
+
+c------------------------
+c
+c freeze sec.elements
+c
+ 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
+c
+c store dist. constrains
+c
+ 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
+c
+c run soft pot. optimization
+c
+ ipot=6
+ wang=3.0
+ maxmin=2000
+ maxfun=4000
+ call geom_to_var(nvar,var)
+ time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+
+ write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
+ time1=MPI_WTIME()
+ 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
+c
+c run full UNRES optimization with constrains and frozen 2D
+c the same variables as soft pot. optimizatio
+c
+ ipot=ipot0
+ wang=wang0
+ maxmin=maxmin0
+ maxfun=maxfun0
+ time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+ write(iout,*)'SUMSL MASK DIST return code is',iretcode,
+ & ' eval ',nfun
+ ieval=nfun
+
+ time1=MPI_WTIME()
+ 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
+c
+c switch off constrains and
+c run full UNRES optimization with frozen 2D
+c
+
+c
+c reset constrains
+c
+ nhpb_c=nhpb
+ nhpb=nhpb0
+ link_start=1
+ link_end=nhpb
+ wstrain=wstrain0
+
+
+ time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+ write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun
+ ieval=ieval+nfun
+
+ time1=MPI_WTIME()
+ 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.
+
+
+c
+c run full UNRES optimization with constrains and NO frozen 2D
+c
+
+ nhpb=nhpb_c
+ link_start=1
+ link_end=nhpb
+ maxfun=maxfun0/5
+
+ do ico=1,5
+
+ wstrain=wstrain0/ico
+
+ 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=nfun
+
+ time1=MPI_WTIME()
+ 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
+c
+ nhpb=nhpb0
+ link_start=1
+ link_end=nhpb
+ wstrain=wstrain0
+ maxfun=maxfun0
+
+
+c
+ if (minim) then
+ time0=MPI_WTIME()
+ call minimize(etot,var,iretcode,nfun)
+ write(iout,*)'------------------------------------------------'
+ write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
+ & '+ DIST eval',ieval
+
+ time1=MPI_WTIME()
+ 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
+
+ return
+ end
+
+
+ subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij)
+ 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'
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision var(maxvar)
+ integer jdata(5),isec(maxres)
+c
+ 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
+
+c
+c cut strands at the ends
+c
+ 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
+
+cv call chainbuild
+cv call etotal(energy(0))
+cv etot=energy(0)
+cv write(iout,*) nnt,nct,etot
+cv call write_pdb(ij*100,'first structure',etot)
+cv write(iout,*) 'N16 test',(jdata(i),i=1,5)
+
+c------------------------
+c generate constrains
+c
+ 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
+cd 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
+cd 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
+cd 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
+
+cv 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
+cv time1=MPI_WTIME()
+cv write (iout,'(a,f6.2,f8.2,a)')
+cv & ' Time for dist min.',time1-time0,
+cv & nfun/(time1-time0),' eval/s'
+cv call var_to_geom(nvar,var)
+cv call chainbuild
+cv call write_pdb(ij*100+ico,'dist cons',etot)
+
+ enddo
+c
+ nhpb=nhpb0
+ call hpb_partition
+ wstrain=wstrain0
+ maxfun=maxfun0
+c
+cd print *,etot
+ wscloc0=wscloc
+ wscloc=10.0
+ call sc_move(nnt,nct,100,100d0,nft_sc,etot)
+ wscloc=wscloc0
+cv call chainbuild
+cv call etotal(energy(0))
+cv etot=energy(0)
+cv call write_pdb(ij*100+10,'sc_move',etot)
+cd call intout
+cd print *,nft_sc,etot
+
+ return
+ end
+
+ subroutine beta_zip(i1,i2,ieval,ij)
+ 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'
+ double precision time0,time1
+ double precision energy(0:n_ene),ee
+ double precision var(maxvar)
+ character*10 test
+
+cv call chainbuild
+cv call etotal(energy(0))
+cv etot=energy(0)
+cv write(test,'(2i5)') i1,i2
+cv call write_pdb(ij*100,test,etot)
+cv write(iout,*) 'N17 test',i1,i2,etot,ij
+
+c
+c generate constrains
+c
+ 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
+cv 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
+cv time1=MPI_WTIME()
+cv write (iout,'(a,f6.2,f8.2,a)')
+cv & ' Time for dist min.',time1-time0,
+cv & nfun/(time1-time0),' eval/s'
+c do not comment the next line
+ call var_to_geom(nvar,var)
+cv call chainbuild
+cv call write_pdb(ij*100+ico,'dist cons',etot)
+ enddo
+
+ nhpb=nhpb0
+ call hpb_partition
+ wstrain=wstrain0
+ maxfun=maxfun0
+
+cv call etotal(energy(0))
+cv etot=energy(0)
+cv write(iout,*) 'N17 test end',i1,i2,etot,ij
+
+
+ return
+ end
projects / unres.git / blobdiff