1 subroutine contact_cp(var,var2,iff,ieval,in_pdb)
2 implicit real*8 (a-h,o-z)
4 include 'COMMON.SBRIDGE'
5 include 'COMMON.FFIELD'
6 include 'COMMON.IOUNITS'
10 include 'COMMON.MINIM'
14 double precision energy(0:n_ene)
15 double precision var(maxvar),var2(maxvar)
16 double precision time0,time1
17 integer iff(maxres),ieval
18 double precision theta1(maxres),phi1(maxres),alph1(maxres),
24 if (ieval.eq.-1) debug=.true.
28 c store selected dist. constrains from 1st structure
31 c Intercept NaNs in the coordinates
32 c write(iout,*) (var(i),i=1,nvar)
37 if (x_sum.ne.x_sum) then
38 write(iout,*)" *** contact_cp : Found NaN in coordinates"
40 print *," *** contact_cp : Found NaN in coordinates"
46 call var_to_geom(nvar,var)
53 if ( iff(i).eq.1.and.iff(j).eq.1 ) then
76 c freeze sec.elements from 2nd structure
84 call var_to_geom(nvar,var2)
85 call secondary2(debug)
87 do i=bfrag(1,j),bfrag(2,j)
92 if (bfrag(3,j).le.bfrag(4,j)) then
93 do i=bfrag(3,j),bfrag(4,j)
99 do i=bfrag(4,j),bfrag(3,j)
107 do i=hfrag(1,j),hfrag(2,j)
116 c copy selected res from 1st to 2nd structure
120 if ( iff(i).eq.1 ) then
130 c prepare description in linia variable
134 if (iff(1).eq.1) then
140 if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then
145 if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then
151 if (iff(nres).eq.1) then
156 write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
157 & "SELECT",ij(1)-1,"-",ij(2)-1,
158 & ",",ij(3)-1,"-",ij(4)-1
164 call contact_cp_min(var,ieval,in_pdb,linia,debug)
169 subroutine contact_cp_min(var,ieval,in_pdb,linia,debug)
171 c input : theta,phi,alph,omeg,in_pdb,linia,debug
174 implicit real*8 (a-h,o-z)
179 include 'COMMON.SBRIDGE'
180 include 'COMMON.FFIELD'
181 include 'COMMON.IOUNITS'
182 include 'COMMON.FRAG'
184 include 'COMMON.CHAIN'
185 include 'COMMON.MINIM'
189 double precision energy(0:n_ene)
190 double precision var(maxvar)
191 double precision time0,time1
192 integer ieval,info(3)
193 logical debug,fail,check_var,reduce,change
195 write(iout,'(a20,i6,a20)')
196 & '------------------',in_pdb,'-------------------'
200 call write_pdb(1000+in_pdb,'combined structure',0d0)
209 c run optimization of distances
211 c uses d0(),w() and mask() for frozen 2D
213 ctest---------------------------------------------
215 ctest NY=((NRES-4)*(NRES-5))/2
216 ctest call distfit(debug,5000)
248 call geom_to_var(nvar,var)
249 cde change=reduce(var)
250 if (check_var(var,info)) then
251 write(iout,*) 'cp_min error in input'
252 print *,'cp_min error in input'
256 cd call etotal(energy(0))
257 cd call enerprint(energy(0))
265 cdtest call minimize(etot,var,iretcode,nfun)
266 cdtest write(iout,*)'SUMSL return code is',iretcode,' eval SDIST',nfun
273 cd call etotal(energy(0))
274 cd call enerprint(energy(0))
293 ctest--------------------------------------------------
301 write (iout,'(a,f6.2,a)')' Time for distfit ',time1-time0,' sec'
302 call write_pdb(2000+in_pdb,'distfit structure',0d0)
311 c run soft pot. optimization
313 c nhpb,ihpb(),jhpb(),forcon(),dhpb() and hpb_partition
315 c mask_phi(),mask_theta(),mask_side(),mask_r
321 cde change=reduce(var)
322 cde if (check_var(var,info)) write(iout,*) 'error before soft'
328 call minimize(etot,var,iretcode,nfun)
330 write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
336 write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
337 & nfun/(time1-time0),' SOFT eval/s'
339 call var_to_geom(nvar,var)
341 call write_pdb(3000+in_pdb,'soft structure',etot)
344 c run full UNRES optimization with constrains and frozen 2D
345 c the same variables as soft pot. optimizatio
351 c check overlaps before calling full UNRES minim
353 call var_to_geom(nvar,var)
355 call etotal(energy(0))
357 write(iout,*) 'N7 ',energy(0)
358 if (energy(0).ne.energy(0)) then
359 write(iout,*) 'N7 error - gives NaN',energy(0)
363 if (energy(1).eq.1.0d20) then
364 write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw=1d20',energy(1)
365 call overlap_sc(fail)
367 call etotal(energy(0))
369 write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw after',energy(1)
381 cdte time0=MPI_WTIME()
382 cde change=reduce(var)
383 cde if (check_var(var,info)) then
384 cde write(iout,*) 'error before mask dist'
385 cde call var_to_geom(nvar,var)
387 cde call write_pdb(10000+in_pdb,'before mask dist',etot)
389 cdte call minimize(etot,var,iretcode,nfun)
390 cdte write(iout,*)'SUMSL MASK DIST return code is',iretcode,
392 cdte ieval=ieval+nfun
394 cdte time1=MPI_WTIME()
395 cdte write (iout,'(a,f6.2,f8.2,a)')
396 cdte & ' Time for mask dist min.',time1-time0,
397 cdte & nfun/(time1-time0),' eval/s'
398 cdte call flush(iout)
400 call var_to_geom(nvar,var)
402 call write_pdb(4000+in_pdb,'mask dist',etot)
405 c switch off freezing of 2D and
406 c run full UNRES optimization with constrains
414 cde change=reduce(var)
415 cde if (check_var(var,info)) then
416 cde write(iout,*) 'error before dist'
417 cde call var_to_geom(nvar,var)
419 cde call write_pdb(11000+in_pdb,'before dist',etot)
422 call minimize(etot,var,iretcode,nfun)
424 cde change=reduce(var)
425 cde if (check_var(var,info)) then
426 cde write(iout,*) 'error after dist',ico
427 cde call var_to_geom(nvar,var)
429 cde call write_pdb(12000+in_pdb+ico*1000,'after dist',etot)
431 write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun
439 write (iout,'(a,f6.2,f8.2,a)')' Time for dist min.',time1-time0,
440 & nfun/(time1-time0),' eval/s'
441 cde call etotal(energy(0))
442 cde write(iout,*) 'N7 after dist',energy(0)
446 call var_to_geom(nvar,var)
448 call write_pdb(in_pdb,linia,etot)
460 c--------------------------------------------------------
462 implicit real*8 (a-h,o-z)
468 include 'COMMON.CHAIN'
469 include 'COMMON.IOUNITS'
471 include 'COMMON.CONTROL'
472 include 'COMMON.SBRIDGE'
473 include 'COMMON.FFIELD'
474 include 'COMMON.MINIM'
475 include 'COMMON.INTERACT'
477 include 'COMMON.FRAG'
479 double precision time0,time1
480 double precision energy(0:n_ene),ee
481 double precision var(maxvar)
484 logical debug,ltest,fail
493 c------------------------
495 c freeze sec.elements
505 do i=bfrag(1,j),bfrag(2,j)
510 if (bfrag(3,j).le.bfrag(4,j)) then
511 do i=bfrag(3,j),bfrag(4,j)
517 do i=bfrag(4,j),bfrag(3,j)
525 do i=hfrag(1,j),hfrag(2,j)
537 c store dist. constrains
541 if ( iff(i).eq.1.and.iff(j).eq.1 ) then
554 call write_pdb(100+in_pdb,'input reg. structure',0d0)
564 c run soft pot. optimization
570 call geom_to_var(nvar,var)
576 call minimize(etot,var,iretcode,nfun)
578 write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun
584 write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0,
585 & nfun/(time1-time0),' SOFT eval/s'
587 call var_to_geom(nvar,var)
589 call write_pdb(300+in_pdb,'soft structure',etot)
592 c run full UNRES optimization with constrains and frozen 2D
593 c the same variables as soft pot. optimizatio
604 call minimize(etot,var,iretcode,nfun)
605 write(iout,*)'SUMSL MASK DIST return code is',iretcode,
614 write (iout,'(a,f6.2,f8.2,a)')
615 & ' Time for mask dist min.',time1-time0,
616 & nfun/(time1-time0),' eval/s'
618 call var_to_geom(nvar,var)
620 call write_pdb(400+in_pdb,'mask & dist',etot)
623 c switch off constrains and
624 c run full UNRES optimization with frozen 2D
642 call minimize(etot,var,iretcode,nfun)
643 write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun
651 write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0,
652 & nfun/(time1-time0),' eval/s'
656 call var_to_geom(nvar,var)
658 call write_pdb(500+in_pdb,'mask 2d frozen',etot)
665 c run full UNRES optimization with constrains and NO frozen 2D
682 call minimize(etot,var,iretcode,nfun)
683 write(iout,'(a10,f6.3,a14,i3,a6,i5)')
684 & ' SUMSL DIST',wstrain,' return code is',iretcode,
693 write (iout,'(a,f6.2,f8.2,a)')
694 & ' Time for dist min.',time1-time0,
695 & nfun/(time1-time0),' eval/s'
697 call var_to_geom(nvar,var)
699 call write_pdb(600+in_pdb+ico,'dist cons',etot)
718 call minimize(etot,var,iretcode,nfun)
719 write(iout,*)'------------------------------------------------'
720 write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun,
721 & '+ DIST eval',ieval
728 write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0,
729 & nfun/(time1-time0),' eval/s'
732 call var_to_geom(nvar,var)
734 call write_pdb(999,'full min',etot)
741 subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij)
742 implicit real*8 (a-h,o-z)
749 include 'COMMON.INTERACT'
750 include 'COMMON.IOUNITS'
751 include 'COMMON.FRAG'
752 include 'COMMON.SBRIDGE'
753 include 'COMMON.CONTROL'
754 include 'COMMON.FFIELD'
755 include 'COMMON.MINIM'
756 include 'COMMON.CHAIN'
757 double precision time0,time1
758 double precision energy(0:n_ene),ee
759 double precision var(maxvar)
760 integer jdata(5),isec(maxres)
768 call secondary2(.false.)
774 do i=bfrag(1,j),bfrag(2,j)
777 do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j))
782 do i=hfrag(1,j),hfrag(2,j)
788 c cut strands at the ends
790 if (jdata(2)-jdata(1).gt.3) then
793 if (jdata(3).lt.jdata(4)) then
803 cv call etotal(energy(0))
805 cv write(iout,*) nnt,nct,etot
806 cv call write_pdb(ij*100,'first structure',etot)
807 cv write(iout,*) 'N16 test',(jdata(i),i=1,5)
809 c------------------------
810 c generate constrains
813 if(ishift.eq.0) ishift=-2
816 do i=jdata(1),jdata(2)
818 if(jdata(4).gt.jdata(3))then
819 do j=jdata(3)+i-jdata(1)-2,jdata(3)+i-jdata(1)+2
821 cd print *,i,j,j+ishift
826 dhpb(nhpb)=DIST(i,j+ishift)
829 do j=jdata(3)-i+jdata(1)+2,jdata(3)-i+jdata(1)-2,-1
831 cd print *,i,j,j+ishift
836 dhpb(nhpb)=DIST(i,j+ishift)
843 if(isec(i).gt.0.or.isec(j).gt.0) then
856 call geom_to_var(nvar,var)
866 call minimize(etot,var,iretcode,nfun)
867 write(iout,'(a10,f6.3,a14,i3,a6,i5)')
868 & ' SUMSL DIST',wstrain,' return code is',iretcode,
872 cv write (iout,'(a,f6.2,f8.2,a)')
873 cv & ' Time for dist min.',time1-time0,
874 cv & nfun/(time1-time0),' eval/s'
875 cv call var_to_geom(nvar,var)
877 cv call write_pdb(ij*100+ico,'dist cons',etot)
889 call sc_move(nnt,nct,100,100d0,nft_sc,etot)
892 cv call etotal(energy(0))
894 cv call write_pdb(ij*100+10,'sc_move',etot)
896 cd print *,nft_sc,etot
901 subroutine beta_zip(i1,i2,ieval,ij)
902 implicit real*8 (a-h,o-z)
909 include 'COMMON.INTERACT'
910 include 'COMMON.IOUNITS'
911 include 'COMMON.FRAG'
912 include 'COMMON.SBRIDGE'
913 include 'COMMON.CONTROL'
914 include 'COMMON.FFIELD'
915 include 'COMMON.MINIM'
916 include 'COMMON.CHAIN'
917 double precision time0,time1
918 double precision energy(0:n_ene),ee
919 double precision var(maxvar)
923 cv call etotal(energy(0))
925 cv write(test,'(2i5)') i1,i2
926 cv call write_pdb(ij*100,test,etot)
927 cv write(iout,*) 'N17 test',i1,i2,etot,ij
930 c generate constrains
941 call geom_to_var(nvar,var)
949 call minimize(etot,var,iretcode,nfun)
950 write(iout,'(a10,f6.3,a14,i3,a6,i5)')
951 & ' SUMSL DIST',wstrain,' return code is',iretcode,
955 cv write (iout,'(a,f6.2,f8.2,a)')
956 cv & ' Time for dist min.',time1-time0,
957 cv & nfun/(time1-time0),' eval/s'
958 c do not comment the next line
959 call var_to_geom(nvar,var)
961 cv call write_pdb(ij*100+ico,'dist cons',etot)
969 cv call etotal(energy(0))
971 cv write(iout,*) 'N17 test end',i1,i2,etot,ij
976 c----------------------------------------------------------------------------
978 subroutine write_pdb(npdb,titelloc,ee)
979 implicit real*8 (a-h,o-z)
981 include 'COMMON.IOUNITS'
982 character*50 titelloc1
983 character*(*) titelloc
992 if (npdb.lt.1000) then
993 call numstr(npdb,zahl)
994 open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb')
996 if (npdb.lt.10000) then
997 write(liczba5,'(i1,i4)') 0,npdb
999 write(liczba5,'(i5)') npdb
1001 open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb')
1003 call pdbout(ee,titelloc1,ipdb)