2 !-----------------------------------------------------------------------------
7 use geometry_data, only: nres,rad2deg
16 !-----------------------------------------------------------------------------
19 ! real(kind=8),dimension(:,:,:,:),allocatable :: dihang_in !(mxang,maxres,mxch,mxio)
20 integer,dimension(:),allocatable :: nss_in !(mxio)
21 integer,dimension(:,:),allocatable :: iss_in,jss_in !(maxss,mxio)
23 real(kind=8),dimension(:,:,:,:),allocatable :: dihang !(mxang,maxres,mxch,mxio)
24 real(kind=8),dimension(:),allocatable :: etot!,rmsn,pncn !(mxio)
25 integer,dimension(:),allocatable :: nss_out !(mxio)
26 integer,dimension(:,:),allocatable ::iss_out,jss_out !(maxss,mxio)
28 ! real(kind=8),dimension(:,:,:,:),allocatable :: bvar !(mxang,maxres,mxch,mxio)
29 ! real(kind=8),dimension(:),allocatable :: bene,rene,&
30 ! brmsn,rrmsn,bpncn,rpncn !(mxio)
31 integer,dimension(:),allocatable :: is,jbank !(mxio)
32 real(kind=8) :: avedif,difmin,ebmin,ebmax,ebmaxt!,&
33 ! dele,difcut,cutdif,rmscut,pnccut
34 real(kind=8),dimension(:,:),allocatable :: dij !(mxio,mxio)
35 ! common/bank_disulfid/
37 integer,dimension(:),allocatable :: movenx,movernx !(mxio)
38 integer,dimension(:,:),allocatable :: nstatnx,nstatnx_tot !(0:mxmv,3)
39 integer,dimension(:,:),allocatable :: indb !(mxio,9)
40 integer,dimension(:,:),allocatable :: parent !(3,mxio)
42 integer,dimension(:),allocatable :: isend2 !(mxio)
43 integer,dimension(:,:),allocatable :: iff_in !(maxres,mxio2)
44 integer,dimension(:,:,:,:),allocatable :: dihang_in2 !(mxang,maxres,mxch,mxio2)
45 integer,dimension(:,:),allocatable :: idata !(5,mxio)
46 !-----------------------------------------------------------------------------
48 ! integer :: irestart,ndiff
50 integer,dimension(:),allocatable :: ngroup !(mxgr)
51 integer,dimension(:,:,:),allocatable :: igroup !(3,mxang,mxgr)
52 integer :: ntotgr!,numch
55 ! real(kind=8) :: rdih_bias
57 !-----------------------------------------------------------------------------
60 integer,dimension(:,:),allocatable :: bvar_frag !(mxio,6)
61 integer,dimension(:,:),allocatable :: hvar_frag,lvar_frag,svar_frag !(mxio,3)
62 integer,dimension(:,:),allocatable :: avar_frag !(mxio,5)
63 !-----------------------------------------------------------------------------
67 integer,dimension(:),allocatable :: nharp_seed,nharp_use !(max_seed)
68 integer,dimension(:,:,:),allocatable :: iharp_seed !(4,maxres/3,max_seed)
69 integer,dimension(:,:,:),allocatable :: iharp_use !(0:4,maxres/3,max_seed)
70 !-----------------------------------------------------------------------------
71 ! Maximum number of moves (n1-n8)
72 integer,parameter :: mxmv=18
73 !-----------------------------------------------------------------------------
76 !-----------------------------------------------------------------------------
78 !-----------------------------------------------------------------------------
80 !-----------------------------------------------------------------------------
81 subroutine refresh_bank(ntrial)
83 ! implicit real*8 (a-h,o-z)
84 ! include 'DIMENSIONS'
86 ! include 'COMMON.CSA'
87 ! include 'COMMON.BANK'
88 ! include 'COMMON.IOUNITS'
89 ! include 'COMMON.CHAIN'
90 ! include 'COMMON.VAR'
91 ! include 'COMMON.CONTROL'
93 integer :: iaccn,ntrial
94 real(kind=8) :: l_diff(mxio),denep
95 integer :: i,j,n,m,i1,idmin
96 real(kind=8) :: del_ene
100 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
105 ! loop over all newly obtained conformations
109 nstatnx(movernx(n),1)=nstatnx(movernx(n),1)+1
110 !ccccccccccccccccccccccccccccccccccccccccccc
113 if(rmsn(n).gt.rmscut.or.pncn(n).lt.pnccut) goto 100
116 if(etot(n).gt.ebmax) goto 100
117 ! Find the conformation closest to the conformation n in the bank
120 call get_diff12(dihang(1,1,1,n),bvar(1,1,1,m),l_diff(m))
121 if(l_diff(m).lt.difmin) then
127 if(difmin.lt.cutdif) then
128 ! n is redundant to idmin
129 if(etot(n).lt.bene(idmin)) then
130 if(etot(n).lt.bene(idmin)-0.01d0) then
134 denep=bene(idmin)-etot(n)
135 call replace_bvar(idmin,n)
138 if (i1.ne.idmin) then
139 dij(i1,idmin)=l_diff(i1)
140 dij(idmin,i1)=l_diff(i1)
145 nstatnx(movernx(n),2)=nstatnx(movernx(n),2)+1
146 if(idmin.eq.ibmax) call find_max
149 ! got new conformation
151 if(ebmax-ebmin.gt.del_ene) then
153 call replace_bvar(ibmax,n)
156 if (i1.ne.ibmax) then
157 dij(i1,ibmax)=l_diff(i1)
158 dij(ibmax,i1)=l_diff(i1)
163 nstatnx(movernx(n),3)=nstatnx(movernx(n),3)+1
168 if(del_ene.lt.0.0001) then
169 write (iout,*) 'ERROR in refresh_bank: '
170 write (iout,*) 'ebmax: ',ebmax
171 write (iout,*) 'ebmin: ',ebmin
172 write (iout,*) 'del_ene: ',del_ene
173 !rc call mpi_abort(mpi_comm_world,ierror,ierrcode)
175 !jp nbmax is never defined so condition below is always false
176 ! if(nbank.lt.nbmax) then
178 ! call replace_bvar(nbank,n)
182 call replace_bvar(ibmax,n)
189 !ccccccccccccccccccccccccccccccccccccccccccc
193 write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5)') &
194 indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',&
195 indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9)
197 write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,0pf4.1,a5,f3.0)') &
198 indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',&
199 indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),&
200 ' rms ',rmsn(n),' %NC ',pncn(n)*100
204 write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,1x,a1,i4,0pf8.1,0pf8.1)') &
205 indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',&
206 indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),&
207 chacc,iaccn,difmin,denep
209 write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,0pf4.1,a5,f3.0,1x,a1,i4,0pf8.1,0pf8.1)') &
210 indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',&
211 indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),&
212 ' rms ',rmsn(n),' %NC ',pncn(n)*100,&
213 chacc,iaccn,difmin,denep
217 ! end of loop over all newly obtained conformations
219 if(nstatnx(i,1).ne.0) then
221 write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
222 '## N',i,' total=',nstatnx(i,1),&
223 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
224 ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
226 write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
227 '##N',i,' total=',nstatnx(i,1),&
228 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
229 ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
233 write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
234 '## N',i,' total=',nstatnx(i,1),&
235 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
238 write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
239 '##N',i,' total=',nstatnx(i,1),&
240 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
247 !rc moved up, saves some get_diff12 calls
251 !rc if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
252 !rc call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
264 end subroutine refresh_bank
265 !-----------------------------------------------------------------------------
266 subroutine replace_bvar(iold,inew)
268 use control_data, only: vdisulf
269 use energy_data, only: ns,iss
270 ! implicit real*8 (a-h,o-z)
271 ! include 'DIMENSIONS'
273 ! include 'COMMON.IOUNITS'
274 ! include 'COMMON.CSA'
275 ! include 'COMMON.BANK'
276 ! include 'COMMON.CHAIN'
277 ! include 'COMMON.CONTROL'
278 ! include 'COMMON.SBRIDGE'
279 integer :: iold,inew,ierror,ierrcode,i,j,k
281 if (iold.gt.mxio .or. iold.lt.1 .or. inew.gt.mxio .or. inew.lt.1) &
283 write (iout,*) 'Dimension ERROR in REPLACE_BVAR: IOLD',iold,&
285 call mpi_abort(mpi_comm_world,ierror,ierrcode)
290 bvar(i,j,k,iold)=dihang(i,j,k,inew)
294 bene(iold)=etot(inew)
295 brmsn(iold)=rmsn(inew)
296 bpncn(iold)=pncn(inew)
298 if(bene(iold).lt.ebmin) then
304 bvar_nss(iold)=nss_out(inew)
305 !d write(iout,*) 'SS BANK',iold,bvar_nss(iold)
306 do i=1,bvar_nss(iold)
307 bvar_ss(1,i,iold)=iss_out(i,inew)
308 bvar_ss(2,i,iold)=jss_out(i,inew)
309 !d write(iout,*) 'SS',bvar_ss(1,i,iold)-nres,
310 !d & bvar_ss(2,i,iold)-nres
313 bvar_ns(iold)=ns-2*bvar_nss(iold)
314 !d write(iout,*) 'CYS #free ', bvar_ns(iold)
318 do while( iss(i).ne.iss_out(j,inew)-nres .and. &
319 iss(i).ne.jss_out(j,inew)-nres .and. &
323 if (j.gt.nss_out(inew)) then
325 bvar_s(k,iold)=iss(i)
328 !d write(iout,*) 'CYS free',(bvar_s(k,iold),k=1,bvar_ns(iold))
332 end subroutine replace_bvar
333 !-----------------------------------------------------------------------------
334 subroutine save_is(ind)
336 ! implicit real*8 (a-h,o-z)
337 ! include 'DIMENSIONS'
339 ! include 'COMMON.IOUNITS'
340 ! include 'COMMON.CSA'
341 ! include 'COMMON.BANK'
342 ! include 'COMMON.CHAIN'
343 integer :: ind,i,j,k,index,ierror,ierrcode
346 ! print *, "nbank,ind,index,is(ind) ",nbank,ind,index,is(ind)
347 if (index.gt.mxio .or. index.lt.1 .or. &
348 is(ind).gt.mxio .or. is(ind).lt.1) then
349 write (iout,*) 'Dimension ERROR in SAVE_IS: INDEX',index,&
350 ' IND',ind,' IS',is(ind)
351 call mpi_abort(mpi_comm_world,ierror,ierrcode)
356 bvar(i,j,k,index)=bvar(i,j,k,is(ind))
360 bene(index)=bene(is(ind))
364 end subroutine save_is
365 !-----------------------------------------------------------------------------
366 subroutine select_is(n,ifar,idum)
368 ! implicit real*8 (a-h,o-z)
369 ! include 'DIMENSIONS'
370 ! include 'COMMON.CSA'
371 ! include 'COMMON.BANK'
372 integer,dimension(mxio) :: itag
373 real(kind=8),dimension(mxio) :: adiff
374 integer :: n,ifar,idum,i,iusesv,imade
378 if(ibank(i).eq.0) then
388 if(ibank(i).eq.2) then
395 call get_is(idum,ifar,n,imade,0)
396 !test3 call get_is_max(idum,ifar,n,imade,0)
397 else if(iuse.eq.n) then
402 else if(iuse.lt.n) then
403 ! if(icycle.eq.0) then
405 ! ind=mod(i-1,iuse)+1
416 ! call get_is_ran(idum,n,imade,1)
417 call get_is(idum,ifar,n,imade,1)
418 !test3 call get_is_max(idum,ifar,n,imade,1)
419 ! if(iusesv.le.n/10) then
423 ! if(ibank(i).eq.2) then
425 if(ibank(i).ge.2) then
434 call get_is(idum,ifar,n,imade,0)
435 !test3 call get_is_max(idum,ifar,n,imade,0)
440 end subroutine select_is
441 !-----------------------------------------------------------------------------
442 subroutine get_is_ran(idum,n,imade,k)
444 ! implicit real*8 (a-h,o-z)
445 ! include 'DIMENSIONS'
446 ! include 'COMMON.CSA'
447 ! include 'COMMON.BANK'
448 ! real(kind=4) :: ran1,ran2
449 integer,dimension(mxio) :: itag
450 real(kind=8),dimension(mxio) :: adiff
451 integer :: idum,n,imade,k,j,i,iran
456 if(ibank(i).eq.k) then
461 iran=iuse* ran1(idum)+1
467 end subroutine get_is_ran
468 !-----------------------------------------------------------------------------
469 subroutine get_is(idum,ifar,n,imade,k)
471 ! implicit real*8 (a-h,o-z)
472 ! include 'DIMENSIONS'
473 ! include 'COMMON.CSA'
474 ! include 'COMMON.BANK'
475 ! real(kind=4) :: ran1,ran2
476 integer,dimension(mxio) :: itag
477 real(kind=8),dimension(mxio) :: adiff
478 integer :: idum,ifar,n,imade,k,i,iran
482 if(ibank(i).eq.k) then
487 iran=iuse* ran1(idum)+1
493 if(icycle.eq.-1) then
494 call select_iseed_max(i,k)
496 call select_iseed_min(i,k)
497 !test4 call select_iseed_max(i,k)
503 call select_iseed_far(i,k)
508 end subroutine get_is
509 !-----------------------------------------------------------------------------
510 subroutine select_iseed_max(imade1,ik)
512 ! implicit real*8 (a-h,o-z)
513 ! include 'DIMENSIONS'
514 ! include 'COMMON.CSA'
515 ! include 'COMMON.BANK'
516 integer,dimension(mxio) :: itag
517 real(kind=8),dimension(mxio) :: adiff
518 integer :: imade1,ik,i,n,imade,m,itagi
519 real(kind=8) :: difmax,diff,emax,benei,diffmn
525 if(ibank(n).eq.ik) then
530 ! call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
533 if(diff.lt.diffmn) diffmn=diff
535 if(diffmn.gt.difmax) difmax=diffmn
543 ! avedif=(avedif+difmax)/2
546 if(adiff(i).ge.avedif) then
549 if(benei.gt.emax) then
556 if(ik.eq.0) iuse=iuse-1
559 end subroutine select_iseed_max
560 !-----------------------------------------------------------------------------
561 subroutine select_iseed_min(imade1,ik)
563 ! implicit real*8 (a-h,o-z)
564 ! include 'DIMENSIONS'
565 ! include 'COMMON.CSA'
566 ! include 'COMMON.BANK'
567 integer,dimension(mxio) :: itag
568 real(kind=8),dimension(mxio) :: adiff
569 integer :: imade1,ik,n,imade,m,i,itagi
570 real(kind=8) :: difmax,diff,diffmn,emin,benei
576 if(ibank(n).eq.ik) then
581 ! call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
584 if(diff.lt.diffmn) diffmn=diff
586 if(diffmn.gt.difmax) difmax=diffmn
594 ! avedif=(avedif+difmax)/2
597 ! print *,"i, adiff(i),avedif : ",i,adiff(i),avedif
598 if(adiff(i).ge.avedif) then
601 ! print *,"i, benei,emin : ",i,benei,emin
602 if(benei.lt.emin) then
609 if(ik.eq.0) iuse=iuse-1
611 ! print *, "exiting select_iseed_min",is(imade1)
614 end subroutine select_iseed_min
615 !-----------------------------------------------------------------------------
616 subroutine select_iseed_far(imade1,ik)
618 ! implicit real*8 (a-h,o-z)
619 ! include 'DIMENSIONS'
620 ! include 'COMMON.CSA'
621 ! include 'COMMON.BANK'
622 integer :: imade1,ik,n,imade,m
623 real(kind=8) :: dmax,diffmn,diff
627 if(ibank(n).eq.ik) then
631 ! call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
634 if(diff.lt.diffmn) diffmn=diff
637 if(diffmn.gt.dmax) then
644 end subroutine select_iseed_far
645 !-----------------------------------------------------------------------------
648 ! implicit real*8 (a-h,o-z)
649 ! include 'DIMENSIONS'
650 ! include 'COMMON.CSA'
651 ! include 'COMMON.BANK'
653 real(kind=8) :: benei
659 if(benei.lt.ebmin) then
666 end subroutine find_min
667 !-----------------------------------------------------------------------------
670 ! implicit real*8 (a-h,o-z)
671 ! include 'DIMENSIONS'
672 ! include 'COMMON.CSA'
673 ! include 'COMMON.BANK'
675 real(kind=8) :: benei
681 if(benei.gt.ebmax) then
688 end subroutine find_max
689 !-----------------------------------------------------------------------------
692 ! implicit real*8 (a-h,o-z)
693 ! include 'DIMENSIONS'
694 ! include 'COMMON.CSA'
695 ! include 'COMMON.BANK'
697 real(kind=8) :: tdiff,difmin,diff
703 if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
704 call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
711 if(diff.lt.difmin) difmin=diff
720 avedif=tdiff/nbank/(nbank-1)*2
723 end subroutine get_diff
724 !-----------------------------------------------------------------------------
725 subroutine estimate_cutdif(adif,xct,cutdifr)
727 ! implicit real*8 (a-h,o-z)
728 ! include 'DIMENSIONS'
729 ! include 'COMMON.CSA'
730 ! include 'COMMON.BANK'
732 real(kind=8) :: adif,xct,cutdifr,ctdif1,exponent
736 exponent = cutdifr*cut1/adif
737 exponent = dlog(exponent)/dlog(xct)
740 cutdif= adif/cut1*xct**nexp
741 if(cutdif.lt.ctdif1) cutdif=ctdif1
744 end subroutine estimate_cutdif
745 !-----------------------------------------------------------------------------
746 subroutine get_is_max(idum,ifar,n,imade,k)
748 ! implicit real*8 (a-h,o-z)
749 ! include 'DIMENSIONS'
750 ! include 'COMMON.CSA'
751 ! include 'COMMON.BANK'
752 integer :: idum,ifar,n,imade,k,i,j
758 if(ibank(j).eq.k .and. bene(j).gt.emax) then
767 end subroutine get_is_max
768 !-----------------------------------------------------------------------------
770 !-----------------------------------------------------------------------------
771 subroutine make_array
773 use energy_data, only: itype
774 ! implicit real*8 (a-h,o-z)
775 ! include 'DIMENSIONS'
776 ! include 'COMMON.IOUNITS'
777 ! include 'COMMON.CHAIN'
778 ! include 'COMMON.INTERACT'
779 ! include 'COMMON.CSA'
780 integer :: k,j,i,indg
781 !cccccccccccccccccccccccc
783 !cccccccccccccccccccccccc
787 !cccccccccccccccccccccccccccccccccccccccc
788 ! Groups the THETAs and the GAMMAs
791 if (j.lt.nres-1) then
802 !cccccccccccccccccccccccccccccccccccccccc
804 ! Groups the ALPHAs and the BETAs
807 if(itype(j,1).ne.10) then
821 write(iout,*) "# of groups: ",ntotgr
823 write(iout,41) i,ngroup(i),((igroup(k,j,i),k=1,3),j=1,ngroup(i))
828 41 format(2i3,3x,6(3i3,2x))
831 end subroutine make_array
832 !-----------------------------------------------------------------------------
833 subroutine make_ranvar(n,m,idum)
836 ! implicit real*8 (a-h,o-z)
837 ! include 'DIMENSIONS'
838 ! include 'COMMON.IOUNITS'
839 ! include 'COMMON.CHAIN'
840 ! include 'COMMON.VAR'
841 ! include 'COMMON.BANK'
842 integer :: n,m,j,idum,itrial,jeden
845 print *,'HOHOHOHO Make_RanVar!!!!!',n,m
847 do while(m.lt.n .and. itrial.le.10000)
850 call gen_rand_conf(jeden,*10)
854 dihang_in(1,j,1,m)=theta(j+1)
855 dihang_in(2,j,1,m)=phi(j+2)
856 dihang_in(3,j,1,m)=alph(j)
857 dihang_in(4,j,1,m)=omeg(j)
859 dihang_in(2,nres-1,1,m)=0.0d0
861 10 write (iout,*) 'Failed to generate conformation #',m+1,&
865 print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
868 end subroutine make_ranvar
869 !-----------------------------------------------------------------------------
870 subroutine make_ranvar_reg(n,idum)
873 ! implicit real*8 (a-h,o-z)
874 ! include 'DIMENSIONS'
875 ! include 'COMMON.IOUNITS'
876 ! include 'COMMON.CHAIN'
877 ! include 'COMMON.VAR'
878 ! include 'COMMON.BANK'
879 ! include 'COMMON.GEO'
880 integer :: n,idum,j,m,itrial,jeden
883 print *,'HOHOHOHO Make_RanVar!!!!!'
885 do while(m.lt.n .and. itrial.le.10000)
888 call gen_rand_conf(jeden,*10)
892 dihang_in(1,j,1,m)=theta(j+1)
893 dihang_in(2,j,1,m)=phi(j+2)
894 dihang_in(3,j,1,m)=alph(j)
895 dihang_in(4,j,1,m)=omeg(j)
897 dihang_in(1,j,1,m)=90.0*deg2rad
898 dihang_in(2,j,1,m)=50.0*deg2rad
901 dihang_in(2,nres-1,1,m)=0.0d0
903 10 write (iout,*) 'Failed to generate conformation #',m+1,&
907 print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
910 end subroutine make_ranvar_reg
911 !-----------------------------------------------------------------------------
913 !-----------------------------------------------------------------------------
914 subroutine get_diff12(aarray,barray,diff)
916 ! implicit real*8 (a-h,o-z)
917 ! include 'DIMENSIONS'
918 ! include 'COMMON.CSA'
919 ! include 'COMMON.BANK'
920 ! include 'COMMON.CHAIN'
921 ! include 'COMMON.GEO'
923 real(kind=8),dimension(mxang,nres,mxch) :: aarray,barray !(mxang,maxres,mxch)
924 real(kind=8) :: diff,dif
932 dif=rad2deg*dabs(aarray(i,j,k)-barray(i,j,k))
933 if(dif.gt.180.) dif=360.-dif
934 if (dif.gt.diffcut) diff=diff+dif
940 end subroutine get_diff12
941 !-----------------------------------------------------------------------------
943 !-----------------------------------------------------------------------------
944 subroutine indexx(n,arr,indx)
946 ! implicit real*8 (a-h,o-z)
948 REAL(kind=8) :: arr(n)
949 ! PARAMETER (M=7,NSTACK=50)
950 integer,PARAMETER :: M=7,NSTACK=500
951 INTEGER :: i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
965 if(arr(indx(i)).le.a)goto 2
971 if(jstack.eq.0)return
980 if(arr(indx(l+1)).gt.arr(indx(ir)))then
985 if(arr(indx(l)).gt.arr(indx(ir)))then
990 if(arr(indx(l+1)).gt.arr(indx(l)))then
1001 if(arr(indx(i)).lt.a)goto 3
1004 if(arr(indx(j)).gt.a)goto 4
1013 if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx'
1014 if(ir-i+1.ge.j-l)then
1025 end subroutine indexx
1026 ! (C) Copr. 1986-92 Numerical Recipes Software *11915aZ%.
1027 !-----------------------------------------------------------------------------
1029 !-----------------------------------------------------------------------------
1030 subroutine minim_jlee
1037 use geometry_data, only: nvar,nphi
1038 use geometry, only:dist
1039 use energy, only:fdum
1040 use control, only:init_int_table
1041 use minimm, only:sumsl,deflt
1042 ! controls minimization and sorting routines
1043 ! implicit real*8 (a-h,o-z)
1044 ! include 'DIMENSIONS'
1045 ! include 'COMMON.VAR'
1046 ! include 'COMMON.IOUNITS'
1047 ! include 'COMMON.MINIM'
1048 ! include 'COMMON.CONTROL'
1050 integer,parameter :: liv=60
1052 ! external func,gradient!,fdum !use minim & energy
1053 ! real(kind=4) :: ran1,ran2,ran3
1054 ! include 'COMMON.SETUP'
1055 ! include 'COMMON.GEO'
1056 ! include 'COMMON.FFIELD'
1057 ! include 'COMMON.SBRIDGE'
1058 ! include 'COMMON.DISTFIT'
1059 ! include 'COMMON.CHAIN'
1060 integer,dimension(mpi_status_size) :: muster
1061 real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
1062 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: erg
1063 real(kind=8),dimension(6*nres) :: var2 !(maxvar) (maxvar=6*maxres)
1064 integer,dimension(nres) :: iffr !(maxres)
1065 integer,dimension((nres-1)*(nres-2)/2) :: ihpbt,jhpbt !(maxdim) (maxdim=(maxres-1)*(maxres-2)/2)
1066 real(kind=8),dimension(6*nres) :: d,garbage !(maxvar) (maxvar=6*maxres)
1067 !el real(kind=8),dimension(1:lv+1) :: v
1068 real(kind=8) :: energia(0:n_ene),time0s,time1s
1069 integer,dimension(9) :: indx
1070 integer,dimension(12) :: info
1071 integer,dimension(liv) :: iv
1073 real(kind=8) :: rdum(1)
1074 integer,dimension(2,12*nres) :: icont_ !(2,maxcont)(maxcont=12*maxres)
1075 logical :: fail !check_var,
1077 !el common /przechowalnia/ v
1078 integer :: i,j,ierr,n,nfun,nft_sc,nf,ierror,ierrcode
1079 real(kind=8) :: rad,eee,etot !,fdum
1080 !el from subroutine parmread
1081 ! Define the constants of the disulfide bridge
1082 ! Old arbitrary potential
1083 real(kind=8),parameter :: dbr=4.20D0
1084 real(kind=8),parameter :: fbr=3.30D0
1086 lv=77+(6*nres)*(6*nres+17)/2 !77+maxvar*(maxvar+17)/2 (maxvar=6*maxres)
1087 data rad /1.745329252d-2/
1088 ! receive # of start
1089 ! print *,'Processor',me,' calling MINIM_JLEE maxfun',maxfun,
1090 ! & ' maxmin',maxmin,' tolf',tolf,' rtolf',rtolf
1091 if (.not. allocated(v)) allocate(v(1:lv))
1095 ! print *, 'MINIM_JLEE: ',me,' is waiting'
1096 call mpi_recv(info,12,mpi_integer,king,idint,CG_COMM,&
1099 write (iout,'(a12,f10.4,a4)')'Waiting for ',time1s-time0s,' sec'
1102 ! print *, 'MINIM_JLEE: ',me,' received: ',n
1104 !rc if (ierr.ne.0) go to 100
1107 write (iout,*) 'Finishing minim_jlee - signal',n,' from master'
1114 call mpi_recv(var,nvar,mpi_double_precision,&
1115 king,idreal,CG_COMM,muster,ierr)
1116 call mpi_recv(iffr,nres,mpi_integer,&
1117 king,idint,CG_COMM,muster,ierr)
1118 call mpi_recv(var2,nvar,mpi_double_precision,&
1119 king,idreal,CG_COMM,muster,ierr)
1121 ! receive initial values of variables
1122 call mpi_recv(var,nvar,mpi_double_precision,&
1123 king,idreal,CG_COMM,muster,ierr)
1124 !rc if (ierr.ne.0) go to 100
1127 if(vdisulf.and.info(2).ne.-1) then
1128 if(info(4).ne.0)then
1129 call mpi_recv(ihpbt,info(4),mpi_integer,&
1130 king,idint,CG_COMM,muster,ierr)
1131 call mpi_recv(jhpbt,info(4),mpi_integer,&
1132 king,idint,CG_COMM,muster,ierr)
1142 call contact_cp(var,var2,iffr,nfun,n)
1145 if(vdisulf.and.info(2).ne.-1) then
1147 if(info(4).ne.0)then
1148 !d write(iout,*) 'SS=',info(4),'N=',info(1),'IT=',info(2)
1149 call var_to_geom(nvar,var)
1152 if (dist(ihpbt(i),jhpbt(i)).lt.7.0) then
1156 !d write(iout,*) 'SS mv=',info(3),
1157 !d & ihpb(nss)-nres,jhpb(nss)-nres,
1158 !d & dist(ihpb(nss),jhpb(nss))
1162 !d write(iout,*) 'rm SS mv=',info(3),
1163 !d & ihpbt(i)-nres,jhpbt(i)-nres,dist(ihpbt(i),jhpbt(i))
1173 if (info(3).eq.14) then
1174 write(iout,*) 'calling local_move',info(7),info(8)
1175 call local_move_init(.false.)
1176 call var_to_geom(nvar,var)
1177 call local_move(info(7),info(8),20d0,50d0)
1178 call geom_to_var(nvar,var)
1182 if (info(3).eq.16) then
1183 write(iout,*) 'calling beta_slide',info(7),info(8),&
1184 info(10), info(11), info(12)
1185 call var_to_geom(nvar,var)
1186 call beta_slide(info(7),info(8),info(10),info(11),info(12), &
1188 call geom_to_var(nvar,var)
1192 if (info(3).eq.17) then
1193 write(iout,*) 'calling beta_zip',info(7),info(8)
1194 call var_to_geom(nvar,var)
1195 call beta_zip(info(7),info(8),nfun,n)
1196 call geom_to_var(nvar,var)
1204 call var_to_geom(nvar,var)
1206 call etotal(energia)
1208 if (energia(1).eq.1.0d20) then
1210 write (iout,'(a,1pe14.5)')'#OVERLAP evdw=1d20',energia(1)
1211 call overlap_sc(fail)
1213 call geom_to_var(nvar,var)
1214 call etotal(energia)
1216 write (iout,'(a,1pe14.5)')'#OVERLAP evdw after',energia(1)
1226 call var_to_geom(nvar,var)
1227 call sc_move(2,nres-1,1,10d0,nft_sc,etot)
1228 call geom_to_var(nvar,var)
1229 !d write(iout,*) 'sc_move',nft_sc,etot
1232 if (check_var(var,info)) then
1241 ! write (iout,*) 'MINIM_JLEE: Processor',me,' nvar',nvar
1242 ! write (iout,'(8f10.4)') (var(i),i=1,nvar)
1243 ! write (*,*) 'MINIM_JLEE: Processor',me,' received nvar',nvar
1244 ! write (*,'(8f10.4)') (var(i),i=1,nvar)
1250 call deflt(2,iv,liv,lv,v)
1251 ! 12 means fresh start, dont call deflt
1253 ! max num of fun calls
1254 if (maxfun.eq.0) maxfun=500
1256 ! max num of iterations
1257 if (maxmin.eq.0) maxmin=1000
1261 ! selects output unit
1264 ! 1 means to print out result
1267 ! 1 means to print out summary stats
1269 ! 1 means to print initial x and d
1272 ! if(me.eq.3.and.n.eq.255) then
1273 ! print *,' CHUJ: stoi'
1280 ! min val for v(radfac) default is 0.1
1282 ! max val for v(radfac) default is 4.0
1285 ! check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
1286 ! the sumsl default is 0.1
1288 ! false conv if (act fnctn decrease) .lt. v(34)
1289 ! the sumsl default is 100*machep
1291 ! absolute convergence
1292 if (tolf.eq.0.0D0) tolf=1.0D-4
1294 ! relative convergence
1295 if (rtolf.eq.0.0D0) rtolf=1.0D-4
1297 ! controls initial step size
1299 ! large vals of d correspond to small components of step
1307 ! write (iout,*) 'Processor',me,' nvar',nvar
1308 ! write (iout,*) 'Variables BEFORE minimization:'
1309 ! write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar)
1311 ! print *, 'MINIM_JLEE: ',me,' before SUMSL '
1313 call func(nvar,var,nf,eee,idum,rdum,fdum)
1315 if(eee.ge.1.0d20) then
1316 ! print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
1317 ! print *,' energy before SUMSL =',eee
1318 ! print *,' aborting local minimization'
1324 !t time0s=MPI_WTIME()
1325 call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
1326 !t write(iout,*) 'sumsl time=',MPI_WTIME()-time0s,iv(7),v(10)
1327 ! print *, 'MINIM_JLEE: ',me,' after SUMSL '
1329 ! find which conformation was returned from sumsl
1331 ! print *,'Processor',me,' iv(17)',iv(17),' iv(18)',iv(18),' nf',nf,
1332 ! & ' retcode',iv(1),' energy',v(10),' tolf',v(31),' rtolf',v(32)
1333 ! if (iv(1).ne.4 .or. nf.le.1) then
1334 ! write (*,*) 'Processor',me,' something bad in SUMSL',iv(1),nf
1335 ! write (*,*) 'Initial Variables'
1336 ! write (*,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar)
1337 ! write (*,*) 'Variables'
1338 ! write (*,'(8f10.4)') (rad2deg*var(i),i=1,nvar)
1339 ! write (*,*) 'Vector d'
1340 ! write (*,'(8f10.4)') (d(i),i=1,nvar)
1341 ! write (iout,*) 'Processor',me,' something bad in SUMSL',
1343 ! write (iout,*) 'Initial Variables'
1344 ! write (iout,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar)
1345 ! write (iout,*) 'Variables'
1346 ! write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar)
1347 ! write (iout,*) 'Vector d'
1348 ! write (iout,'(8f10.4)') (d(i),i=1,nvar)
1350 ! if (nf.lt.iv(6)-1) then
1351 ! recalculate intra- and interchain energies
1352 ! call func(nvar,var,nf,v(10),iv,v,fdum)
1353 ! else if (nf.eq.iv(6)-1) then
1354 ! regenerate conformation
1355 ! call var_to_geom(nvar,var)
1358 ! change origin and axes to standard ECEPP format
1359 ! call var_to_geom(nvar,var)
1360 ! write (iout,*) 'MINIM_JLEE after minim: Processor',me,' nvar',nvar
1361 ! write (iout,'(8f10.4)') (var(i),i=1,nvar)
1362 ! write (iout,*) 'Energy:',v(10)
1364 ! print *, 'MINIM_JLEE: ',me,' minimized: ',n
1367 ! return code: 6-gradient 9-number of ftn evaluation, etc
1369 ! total # of ftn evaluations (for iwf=0, it includes all minimizations).
1377 call mpi_send(indx,9,mpi_integer,king,idint,CG_COMM,&
1379 ! send back energies
1381 ! calculate contact order
1383 call contact(.false.,ncont,icont_,co)
1384 erg(1)=v(10)-1.0d2*co
1389 call mpi_send(erg,j,mpi_double_precision,king,idreal,&
1392 call mpi_send(co,j,mpi_double_precision,king,idreal,&
1395 ! send back values of variables
1396 call mpi_send(var,nvar,mpi_double_precision,&
1397 king,idreal,CG_COMM,ierr)
1398 ! print * , 'MINIM_JLEE: Processor',me,' send erg and var '
1400 if(vdisulf.and.info(2).ne.-1.and.nss.ne.0) then
1403 !d call etotal(energia(0))
1405 !d call enerprint(energia(0))
1406 call mpi_send(ihpb,nss,mpi_integer,&
1407 king,idint,CG_COMM,ierr)
1408 call mpi_send(jhpb,nss,mpi_integer,&
1409 king,idint,CG_COMM,ierr)
1413 100 print *, ' error in receiving message from emperor', me
1414 call mpi_abort(mpi_comm_world,ierror,ierrcode)
1416 200 print *, ' error in sending message to emperor'
1417 call mpi_abort(mpi_comm_world,ierror,ierrcode)
1419 300 print *, ' error in communicating with emperor'
1420 call mpi_abort(mpi_comm_world,ierror,ierrcode)
1422 956 format (' initial energy could not be calculated',41x)
1424 965 format (' convergence code ',i2,' # of function calls ',&
1425 i4,' # of gradient calls ',i4,10x)
1426 975 format (' energy ',1p,e12.4,' scaled gradient ',e11.3,32x)
1427 end subroutine minim_jlee
1428 !-----------------------------------------------------------------------------
1430 !-----------------------------------------------------------------------------
1431 subroutine make_var(n,idum,iter_csa)
1436 use control_data, only: vdisulf
1438 use geometry, only: dist
1441 ! use random, only: iran_num,ran_number
1442 ! implicit real*8 (a-h,o-z)
1443 ! include 'DIMENSIONS'
1444 ! include 'COMMON.IOUNITS'
1445 ! include 'COMMON.CSA'
1446 ! include 'COMMON.BANK'
1447 ! include 'COMMON.CHAIN'
1448 ! include 'COMMON.INTERACT'
1449 ! include 'COMMON.HAIRPIN'
1450 ! include 'COMMON.VAR'
1451 ! include 'COMMON.DISTFIT'
1452 ! include 'COMMON.GEO'
1453 ! include 'COMMON.CONTROL'
1454 logical :: nicht_getan,nicht_getan1,fail,lfound
1455 integer :: nharp,iharp(4,nres/3),nconf_harp
1456 integer :: iisucc(mxio)
1457 logical :: ifused(mxio)
1458 integer :: nhx_seed(nseed),ihx_seed(4,nres/3,nseed) !max_seed
1459 integer :: nhx_use(nseed),ihx_use(0:4,nres/3,nseed)
1460 integer :: nlx_seed(nseed),ilx_seed(2,nres/3,nseed),&
1461 nlx_use(nseed),ilx_use(nres/3,nseed)
1462 ! real(kind=4) :: ran1,ran2
1464 integer :: i,j,k,n,idum,iter_csa,iran,index,n7frag,n8frag,n14frag,&
1465 n15frag,nbefrag,nlx_tot,iters,i1,i2,i3,ntot_gen,ngen,iih,&
1466 ij,jr,iim,nhx_tot,idummy,iter,iif,iig,icheck,ishift,iang,&
1467 n8c,ih_start,ih_end,n7c,index2,isize,nsucc,nacc,j1,nran,&
1471 write (iout,*) 'make_var : nseed=',nseed,'ntry=',n
1474 !-----------------------------------------
1475 if (n7.gt.0.or.n8.gt.0.or.n9.gt.0.or.n14.gt.0.or.n15.gt.0 &
1476 .or.n16.gt.0.or.n17.gt.0.or.n18.gt.0) &
1477 call select_frag(n7frag,n8frag,n14frag,&
1478 n15frag,nbefrag,iter_csa)
1480 !---------------------------------------------------
1481 ! N18 - random perturbation of one phi(=gamma) angle in a loop
1489 if (lvar_frag(i2,1).eq.i1) then
1490 nlx_seed(iters)=nlx_seed(iters)+5
1491 ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2)
1492 ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3)
1493 ilx_use(nlx_seed(iters),iters)=5
1496 nlx_use(iters)=nlx_seed(iters)
1497 nlx_tot=nlx_tot+nlx_seed(iters)
1500 if (nlx_tot .ge. n18*nseed) then
1503 ntot_gen=(nlx_tot/nseed)*nseed
1507 do while (ngen.lt.ntot_gen)
1510 if (nlx_use(iters).gt.0) then
1512 do while (nicht_getan)
1513 iih=iran_num(1,nlx_seed(iters))
1514 if (ilx_use(iih,iters).gt.0) then
1516 ilx_use(iih,iters)=ilx_use(iih,iters)-1
1517 nlx_use(iters)=nlx_use(iters)-1
1523 parent(1,index)=iseed
1528 nss_in(index)=bvar_nss(iseed)
1529 do ij=1,nss_in(index)
1530 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1531 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1539 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1544 jr=iran_num(ilx_seed(1,iih,iters),ilx_seed(2,iih,iters))
1545 d=ran_number(-pi,pi)
1546 dihang_in(2,jr-2,1,index)=pinorm(dihang_in(2,jr-2,1,index)+d)
1549 if (ngen.eq.ntot_gen) goto 145
1558 !-----------------------------------------
1559 ! N17 : zip a beta in a seed by forcing one additional p-p contact
1568 if (avar_frag(i2,1).eq.i1) then
1569 nhx_seed(iters)=nhx_seed(iters)+1
1570 ihx_use(2,nhx_seed(iters),iters)=1
1571 if (avar_frag(i2,5)-avar_frag(i2,3).le.3.and. &
1572 avar_frag(i2,2).gt.1.and.avar_frag(i2,4).lt.nres) then
1573 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
1574 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1
1575 ihx_use(0,nhx_seed(iters),iters)=1
1576 ihx_use(1,nhx_seed(iters),iters)=0
1577 nhx_use(iters)=nhx_use(iters)+1
1579 if (avar_frag(i2,4).gt.avar_frag(i2,5)) then
1580 if (avar_frag(i2,2).gt.1.and. &
1581 avar_frag(i2,4).lt.nres) then
1582 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
1583 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1
1584 ihx_use(0,nhx_seed(iters),iters)=1
1585 ihx_use(1,nhx_seed(iters),iters)=0
1586 nhx_use(iters)=nhx_use(iters)+1
1588 if (avar_frag(i2,3).lt.nres.and. &
1589 avar_frag(i2,5).gt.1) then
1590 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1
1591 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)-1
1592 ihx_use(0,nhx_seed(iters),iters)= &
1593 ihx_use(0,nhx_seed(iters),iters)+1
1594 ihx_use(2,nhx_seed(iters),iters)=0
1595 nhx_use(iters)=nhx_use(iters)+1
1598 if (avar_frag(i2,2).gt.1.and. &
1599 avar_frag(i2,4).gt.1) then
1600 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
1601 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)-1
1602 ihx_use(0,nhx_seed(iters),iters)=1
1603 ihx_use(1,nhx_seed(iters),iters)=0
1604 nhx_use(iters)=nhx_use(iters)+1
1606 if (avar_frag(i2,3).lt.nres.and. &
1607 avar_frag(i2,5).lt.nres) then
1608 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1
1609 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)+1
1610 ihx_use(0,nhx_seed(iters),iters)= &
1611 ihx_use(0,nhx_seed(iters),iters)+1
1612 ihx_use(2,nhx_seed(iters),iters)=0
1613 nhx_use(iters)=nhx_use(iters)+1
1620 nhx_tot=nhx_tot+nhx_use(iters)
1621 !d write (iout,*) "debug N17",iters,nhx_seed(iters),
1622 !d & nhx_use(iters),nhx_tot
1625 if (nhx_tot .ge. n17*nseed) then
1627 else if (nhx_tot .ge. nseed) then
1628 ntot_gen=(nhx_tot/nseed)*nseed
1632 !d write (iout,*) "debug N17==",ntot_gen,nhx_tot,nseed
1635 do while (ngen.lt.ntot_gen)
1638 if (nhx_use(iters).gt.0) then
1639 !d write (iout,*) "debug N17",nhx_use(iters),ngen,ntot_gen
1640 !d write (iout,*) "debugN17^",
1641 !d & (ihx_use(0,k,iters),k=1,nhx_use(iters))
1643 do while (nicht_getan)
1644 iih=iran_num(1,nhx_seed(iters))
1645 !d write (iout,*) "debugN17^",iih
1646 if (ihx_use(0,iih,iters).gt.0) then
1648 !d write (iout,*) "debugN17=",iih,nhx_seed(iters)
1649 !d write (iout,*) "debugN17-",iim,'##',
1650 !d & (ihx_use(k,iih,iters),k=0,2)
1652 do while (ihx_use(iim,iih,iters).eq.1)
1654 !d write (iout,*) "debugN17-",iim,'##',
1655 !d & (ihx_use(k,iih,iters),k=0,2)
1659 ihx_use(iim,iih,iters)=1
1660 ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
1661 nhx_use(iters)=nhx_use(iters)-1
1667 parent(1,index)=iseed
1671 nss_in(index)=bvar_nss(iseed)
1672 do ij=1,nss_in(index)
1673 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1674 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1681 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1687 idata(1,index)=ihx_seed(1,iih,iters)
1688 idata(2,index)=ihx_seed(2,iih,iters)
1690 idata(1,index)=ihx_seed(3,iih,iters)
1691 idata(2,index)=ihx_seed(4,iih,iters)
1694 if (ngen.eq.ntot_gen) goto 115
1699 write (iout,*) "N17",n17," ngen/nseed",ngen/nseed,&
1704 !-----------------------------------------
1705 ! N16 : slide non local beta in a seed by +/- 1 or +/- 2
1713 if (bvar_frag(i2,1).eq.i1) then
1714 nhx_seed(iters)=nhx_seed(iters)+1
1715 ihx_seed(1,nhx_seed(iters),iters)=bvar_frag(i2,3)
1716 ihx_seed(2,nhx_seed(iters),iters)=bvar_frag(i2,4)
1717 ihx_seed(3,nhx_seed(iters),iters)=bvar_frag(i2,5)
1718 ihx_seed(4,nhx_seed(iters),iters)=bvar_frag(i2,6)
1719 ihx_use(0,nhx_seed(iters),iters)=4
1721 ihx_use(i3,nhx_seed(iters),iters)=0
1725 nhx_use(iters)=4*nhx_seed(iters)
1726 nhx_tot=nhx_tot+nhx_seed(iters)
1727 !d write (iout,*) "debug N16",iters,nhx_seed(iters)
1730 if (4*nhx_tot .ge. n16*nseed) then
1732 else if (4*nhx_tot .ge. nseed) then
1733 ntot_gen=(4*nhx_tot/nseed)*nseed
1737 write (iout,*) "debug N16",ntot_gen,4*nhx_tot,nseed
1740 do while (ngen.lt.ntot_gen)
1743 if (nhx_use(iters).gt.0) then
1745 do while (nicht_getan)
1746 iih=iran_num(1,nhx_seed(iters))
1747 if (ihx_use(0,iih,iters).gt.0) then
1749 do while (ihx_use(iim,iih,iters).eq.1)
1750 !d write (iout,*) iim,
1751 !d & ihx_use(0,iih,iters),ihx_use(iim,iih,iters)
1755 ihx_use(iim,iih,iters)=1
1756 ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
1757 nhx_use(iters)=nhx_use(iters)-1
1763 parent(1,index)=iseed
1767 nss_in(index)=bvar_nss(iseed)
1768 do ij=1,nss_in(index)
1769 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1770 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1777 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1783 idata(i,index)=ihx_seed(i,iih,iters)
1787 if (ngen.eq.ntot_gen) goto 116
1792 write (iout,*) "N16",n16," ngen/nseed",ngen/nseed,&
1795 !-----------------------------------------
1796 ! N15 : copy two 2nd structure elements from 1 or 2 conf. in bank to a seed
1811 iif=iran_num(1,n15frag)
1812 do while( (ifused(iif) .or. svar_frag(iif,1).eq.iseed) .and. &
1814 iif=iran_num(1,n15frag)
1817 if(iran.ge.mxio) goto 811
1820 iig=iran_num(1,n15frag)
1821 do while( (ifused(iig) .or. svar_frag(iig,1).eq.iseed .or. &
1822 .not.(svar_frag(iif,3).lt.svar_frag(iig,2).or. &
1823 svar_frag(iig,3).lt.svar_frag(iif,2)) ) .and. &
1825 iig=iran_num(1,n15frag)
1828 if(iran.ge.mxio) goto 811
1832 parent(1,index)=iseed
1833 parent(2,index)=svar_frag(iif,1)
1834 parent(3,index)=svar_frag(iig,1)
1838 nss_in(index)=bvar_nss(iseed)
1839 do ij=1,nss_in(index)
1840 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1841 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1847 call newconf_copy(idum,dihang_in(1,1,1,index),&
1848 svar_frag(iif,1),svar_frag(iif,2),svar_frag(iif,3))
1850 do j=svar_frag(iig,2),svar_frag(iig,3)
1852 dihang_in(i,j,1,index)=bvar(i,j,1,svar_frag(iig,1))
1858 call check_old(icheck,index)
1859 if(icheck.eq.1) then
1871 !-----------------------------------------
1872 ! N14 local_move (Maurizio) for loops in a seed
1880 if (lvar_frag(i2,1).eq.i1) then
1881 nlx_seed(iters)=nlx_seed(iters)+3
1882 ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2)
1883 ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3)
1884 ilx_use(nlx_seed(iters),iters)=3
1887 nlx_use(iters)=nlx_seed(iters)
1888 nlx_tot=nlx_tot+nlx_seed(iters)
1889 !d write (iout,*) "debug N14",iters,nlx_seed(iters)
1892 if (nlx_tot .ge. n14*nseed) then
1895 ntot_gen=(nlx_tot/nseed)*nseed
1897 !d write (iout,*) "debug N14",ntot_gen,n14frag,nseed
1900 do while (ngen.lt.ntot_gen)
1903 if (nlx_use(iters).gt.0) then
1905 do while (nicht_getan)
1906 iih=iran_num(1,nlx_seed(iters))
1907 if (ilx_use(iih,iters).gt.0) then
1909 ilx_use(iih,iters)=ilx_use(iih,iters)-1
1910 nlx_use(iters)=nlx_use(iters)-1
1916 parent(1,index)=iseed
1919 idata(1,index)=ilx_seed(1,iih,iters)
1920 idata(2,index)=ilx_seed(2,iih,iters)
1924 nss_in(index)=bvar_nss(iseed)
1925 do ij=1,nss_in(index)
1926 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1927 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1935 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1940 if (ngen.eq.ntot_gen) goto 131
1945 !d write (iout,*) "N14",n14," ngen/nseed",ngen/nseed,
1949 !-----------------------------------------
1950 ! N9 : shift a helix in a seed
1958 if (hvar_frag(i2,1).eq.i1) then
1959 nhx_seed(iters)=nhx_seed(iters)+1
1960 ihx_seed(1,nhx_seed(iters),iters)=hvar_frag(i2,2)
1961 ihx_seed(2,nhx_seed(iters),iters)=hvar_frag(i2,3)
1962 ihx_use(0,nhx_seed(iters),iters)=4
1964 ihx_use(i3,nhx_seed(iters),iters)=0
1968 nhx_use(iters)=4*nhx_seed(iters)
1969 nhx_tot=nhx_tot+nhx_seed(iters)
1970 !d write (iout,*) "debug N9",iters,nhx_seed(iters)
1973 if (4*nhx_tot .ge. n9*nseed) then
1976 ntot_gen=(4*nhx_tot/nseed)*nseed
1978 !d write (iout,*) "debug N9",ntot_gen,n8frag,nseed
1981 do while (ngen.lt.ntot_gen)
1984 if (nhx_use(iters).gt.0) then
1986 do while (nicht_getan)
1987 iih=iran_num(1,nhx_seed(iters))
1988 if (ihx_use(0,iih,iters).gt.0) then
1990 do while (ihx_use(iim,iih,iters).eq.1)
1991 !d write (iout,*) iim,
1992 !d & ihx_use(0,iih,iters),ihx_use(iim,iih,iters)
1996 ihx_use(iim,iih,iters)=1
1997 ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
1998 nhx_use(iters)=nhx_use(iters)-1
2004 parent(1,index)=iseed
2008 nss_in(index)=bvar_nss(iseed)
2009 do ij=1,nss_in(index)
2010 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2011 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2018 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2023 jstart=max(nnt,ihx_seed(1,iih,iters)+1)
2024 jend=min(nct,ihx_seed(2,iih,iters))
2025 !d write (iout,*) "debug N9",iters,iih,jstart,jend
2028 else if (iim.eq.2) then
2030 else if (iim.eq.3) then
2032 else if (iim.eq.4) then
2035 write (iout,*) 'CHUJ NASTAPIL: iim=',iim
2037 call mpi_abort(mpi_comm_world,ierror,ierrcode)
2041 if (itype(j,1).eq.10) then
2047 if (j+ishift.ge.nnt.and.j+ishift.le.nct) &
2048 dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed)
2051 if (ishift.gt.0) then
2053 if (itype(jend+j,1).eq.10) then
2059 if (jend+j.ge.nnt.and.jend+j.le.nct) &
2060 dihang_in(i,jstart+j,1,index)=bvar(i,jend+j,1,iseed)
2065 if (itype(jstart+j,1).eq.10) then
2071 if (jend+j.ge.nnt.and.jend+j.le.nct) &
2072 dihang_in(i,jend+j,1,index)=bvar(i,jstart+j,1,iseed)
2076 if (ngen.eq.ntot_gen) goto 133
2081 !d write (iout,*) "N9",n9," ngen/nseed",ngen/nseed,
2085 !-----------------------------------------
2086 ! N8 : copy a helix from bank to seed
2089 if (n8frag.lt.n8) then
2090 write (iout,*) "N8: only ",n8frag,'helices'
2107 iif=iran_num(1,n8frag)
2108 do while( (ifused(iif) .or. hvar_frag(iif,1).eq.iseed) .and. &
2110 iif=iran_num(1,n8frag)
2114 if(iran.ge.mxio) goto 911
2118 parent(1,index)=iseed
2119 parent(2,index)=hvar_frag(iif,1)
2123 nss_in(index)=bvar_nss(iseed)
2124 do ij=1,nss_in(index)
2125 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2126 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2131 if (hvar_frag(iif,3)-hvar_frag(iif,2).le.6) then
2132 call newconf_copy(idum,dihang_in(1,1,1,index),&
2133 hvar_frag(iif,1),hvar_frag(iif,2),hvar_frag(iif,3))
2135 ih_start=iran_num(hvar_frag(iif,2),hvar_frag(iif,3)-6)
2136 ih_end=iran_num(ih_start,hvar_frag(iif,3))
2137 call newconf_copy(idum,dihang_in(1,1,1,index),&
2138 hvar_frag(iif,1),ih_start,ih_end)
2142 call check_old(icheck,index)
2143 if(icheck.eq.1) then
2158 !-----------------------------------------
2159 ! N7 : copy nonlocal beta fragment from bank to seed
2162 if (n7frag.lt.n7) then
2163 write (iout,*) "N7: only ",n7frag,'nonlocal fragments'
2187 iif=iran_num(1,n7frag)
2188 do while( (ifused(iif) .or. bvar_frag(iif,1).eq.iseed) .and. &
2190 iif=iran_num(1,n7frag)
2194 !d write (*,'(3i5,l,4i5)'),iters,idummy,iif,ifused(iif),
2195 !d & bvar_frag(iif,1),iseed,iran,index2
2197 if(iran.ge.mxio) goto 999
2198 if(index2.ge.mxio2) goto 999
2202 parent(1,index)=iseed
2203 parent(2,index)=bvar_frag(iif,1)
2205 isend2(index)=index2
2209 nss_in(index)=bvar_nss(iseed)
2210 do ij=1,nss_in(index)
2211 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2212 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2219 dihang_in2(i,j,k,index2)=bvar(i,j,k,bvar_frag(iif,1))
2224 if (bvar_frag(iif,2).eq.4) then
2225 do i=bvar_frag(iif,3),bvar_frag(iif,4)
2228 if (bvar_frag(iif,5).lt.bvar_frag(iif,6)) then
2229 !d print *,'###',bvar_frag(iif,3),bvar_frag(iif,4),
2230 !d & bvar_frag(iif,5),bvar_frag(iif,6)
2231 do i=bvar_frag(iif,5),bvar_frag(iif,6)
2235 !d print *,'###',bvar_frag(iif,3),bvar_frag(iif,4),
2236 !d & bvar_frag(iif,6),bvar_frag(iif,5)
2237 do i=bvar_frag(iif,6),bvar_frag(iif,5)
2246 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2258 !-----------------------------------------------
2259 ! N6 : copy random continues fragment from bank to seed
2264 isize=(is2-is1+1)*ran1(idum)+is1
2270 nss_in(index)=bvar_nss(iseed)
2271 do ij=1,nss_in(index)
2272 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2273 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2279 if(icycle.le.0) then
2280 i1=nconf* ran1(idum)+1
2283 i1=nbank* ran1(idum)+1
2285 if(i1.eq.iseed) goto 104
2287 call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
2288 parent(1,index)=iseed
2291 call check_old(icheck,index)
2292 if(icheck.eq.1) goto 104
2296 !-----------------------------------------
2297 if (n3.gt.0.or.n4.gt.0) call gen_hairpin
2300 if (nharp_seed(iters).gt.0) nconf_harp=nconf_harp+1
2302 !-----------------------------------------
2303 ! N3 : copy hairpin from bank to seed
2313 if(icycle.le.0) then
2314 i1=nconf* ran1(idum)+1
2317 i1=nbank* ran1(idum)+1
2319 if(i1.eq.iseed) goto 124
2321 if (i1.eq.iisucc(k).and.nsucc.lt.nconf_harp-1) goto 124
2326 call newconf_residue_hairpin(idum,dihang_in(1,1,1,index),&
2329 if (icycle.le.0 .and. nsucc.eq.nconf .or. &
2330 icycle.gt.0 .and. nsucc.eq.nbank) then
2338 call check_old(icheck,index)
2339 if(icheck.eq.1) goto 124
2342 parent(1,index)=iseed
2347 nss_in(index)=bvar_nss(iseed)
2348 do ij=1,nss_in(index)
2349 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2350 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2356 ! if not enough hairpins, supplement with windows
2358 !dd if (n3.ne.0) write (iout,*) "N3",n3," nsucc",nsucc," nacc",nacc
2360 isize=(is2-is1+1)*ran1(idum)+is1
2363 parent(1,index)=iseed
2368 nss_in(index)=bvar_nss(iseed)
2369 do ij=1,nss_in(index)
2370 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2371 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2377 if(icycle.le.0) then
2378 i1=nconf* ran1(idum)+1
2381 i1=nbank* ran1(idum)+1
2383 if(i1.eq.iseed) goto 114
2385 call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
2387 call check_old(icheck,index)
2388 if(icheck.eq.1) goto 114
2392 !-----------------------------------------
2393 ! N4 : shift a turn in hairpin in seed
2396 if (4*nharp_tot .ge. n4*nseed) then
2399 ntot_gen=(4*nharp_tot/nseed)*nseed
2402 do while (ngen.lt.ntot_gen)
2405 ! write (iout,*) 'iters',iters,' iseed',iseed,' nharp_seed',
2406 ! & nharp_seed(iters),' nharp_use',nharp_use(iters),
2407 ! & ' ntot_gen',ntot_gen
2408 ! write (iout,*) 'iharp_use(0)',
2409 ! & (iharp_use(0,k,iters),k=1,nharp_seed(iters))
2410 if (nharp_use(iters).gt.0) then
2412 do while (nicht_getan)
2413 iih=iran_num(1,nharp_seed(iters))
2414 ! write (iout,*) 'iih',iih,' iharp_use',
2415 ! & (iharp_use(k,iih,iters),k=1,4)
2416 if (iharp_use(0,iih,iters).gt.0) then
2418 do while (nicht_getan1)
2420 nicht_getan1=iharp_use(iim,iih,iters).eq.1
2423 iharp_use(iim,iih,iters)=1
2424 iharp_use(0,iih,iters)=iharp_use(0,iih,iters)-1
2425 nharp_use(iters)=nharp_use(iters)-1
2426 !dd write (iout,'(a16,i3,a5,i2,a10,2i4)')
2427 !dd & 'N4 selected hairpin',iih,' move',iim,' iharp_seed',
2428 !dd & iharp_seed(1,iih,iters),iharp_seed(2,iih,iters)
2434 parent(1,index)=iseed
2439 nss_in(index)=bvar_nss(iseed)
2440 do ij=1,nss_in(index)
2441 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2442 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2449 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2453 jstart=iharp_seed(1,iih,iters)+1
2454 jend=iharp_seed(2,iih,iters)
2457 else if (iim.eq.2) then
2459 else if (iim.eq.3) then
2461 else if (iim.eq.4) then
2464 write (iout,*) 'CHUJ NASTAPIL: iim=',iim
2466 call mpi_abort(mpi_comm_world,ierror,ierrcode)
2469 ! write (iout,*) 'jstart',jstart,' jend',jend,' ishift',ishift
2470 ! write (iout,*) 'Before turn shift'
2472 ! theta(j+1)=dihang_in(1,j,1,index)
2473 ! phi(j+2)=dihang_in(2,j,1,index)
2474 ! alph(j)=dihang_in(3,j,1,index)
2475 ! omeg(j)=dihang_in(4,j,1,index)
2479 if (itype(j,1).eq.10) then
2485 if (j+ishift.ge.nnt.and.j+ishift.le.nct) &
2486 dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed)
2489 ! write (iout,*) 'After turn shift'
2491 ! theta(j+1)=dihang_in(1,j,1,index)
2492 ! phi(j+2)=dihang_in(2,j,1,index)
2493 ! alph(j)=dihang_in(3,j,1,index)
2494 ! omeg(j)=dihang_in(4,j,1,index)
2497 if (ngen.eq.ntot_gen) goto 135
2501 ! if not enough hairpins, supplement with windows
2502 ! write (iout,*) 'end of enddo'
2504 !dd write (iout,*) "N4",n4," ngen/nseed",ngen/nseed,
2508 do idummy=ngen/nseed+1,n4
2509 isize=(is2-is1+1)*ran1(idum)+is1
2514 nss_in(index)=bvar_nss(iseed)
2515 do ij=1,nss_in(index)
2516 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2517 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2524 if(icycle.le.0) then
2525 i1=nconf* ran1(idum)+1
2528 i1=nbank* ran1(idum)+1
2530 if(i1.eq.iseed) goto 134
2532 call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
2533 parent(1,index)=iseed
2536 call check_old(icheck,index)
2537 if(icheck.eq.1) goto 134
2542 !-----------------------------------------
2543 ! N5 : copy one residue from bank to seed (normally switched off - use N1)
2553 nss_in(index)=bvar_nss(iseed)
2554 do ij=1,nss_in(index)
2555 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2556 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2563 if(icycle.le.0) then
2564 i1=nconf* ran1(idum)+1
2567 i1=nbank* ran1(idum)+1
2569 if(i1.eq.iseed) goto 105
2571 call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
2572 parent(1,index)=iseed
2575 call check_old(icheck,index)
2576 if(icheck.eq.1) goto 105
2580 !-----------------------------------------
2581 ! N2 : copy backbone of one residue from bank or first bank to seed
2582 ! (normally switched off - use N1)
2587 if(icycle.le.0.and.iuse.gt.nconf-irr) then
2588 iseed=ran1(idum)*nconf+1
2589 iseed=nbank-nconf+iseed
2595 nss_in(index)=bvar_nss(iseed)
2596 do ij=1,nss_in(index)
2597 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2598 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2603 102 i1= ran1(idum)*nbank+1
2604 if(i1.eq.iseed) goto 102
2606 if(icycle.le.0.and.iuse.gt.nconf-irr) then
2607 nran=mod(i-1,nran0)+3
2608 call newconf1arr(idum,dihang_in(1,1,1,index),nran,i1)
2609 parent(1,index)=-iseed
2611 else if(icycle.le.0.and.iters.le.iuse) then
2612 nran=mod(i-1,nran0)+1
2613 call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1)
2614 parent(1,index)=iseed
2617 nran=mod(i-1,nran1)+1
2618 if(ran1(idum).lt.0.5) then
2619 call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1)
2620 parent(1,index)=iseed
2623 call newconf1abb(idum,dihang_in(1,1,1,index),nran,i1)
2624 parent(1,index)=iseed
2629 call check_old(icheck,index)
2630 if(icheck.eq.1) goto 102
2634 !-----------------------------------------
2635 ! N1 : copy backbone or sidechain of one residue from bank or
2636 ! first bank to seed
2641 if(icycle.le.0.and.iuse.gt.nconf-irr) then
2642 iseed=ran1(idum)*nconf+1
2643 iseed=nbank-nconf+iseed
2649 nss_in(index)=bvar_nss(iseed)
2650 do ij=1,nss_in(index)
2651 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2652 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2657 101 i1= ran1(idum)*nbank+1
2659 if(i1.eq.iseed) goto 101
2661 if(icycle.le.0.and.iuse.gt.nconf-irr) then
2662 nran=mod(i-1,nran0)+3
2663 call newconf1rr(idum,dihang_in(1,1,1,index),nran,i1)
2664 parent(1,index)=-iseed
2666 else if(icycle.le.0.and.iters.le.iuse) then
2667 nran=mod(i-1,nran0)+1
2668 call newconf1br(idum,dihang_in(1,1,1,index),nran,i1)
2669 parent(1,index)=iseed
2672 nran=mod(i-1,nran1)+1
2673 if(ran1(idum).lt.0.5) then
2674 call newconf1br(idum,dihang_in(1,1,1,index),nran,i1)
2675 parent(1,index)=iseed
2678 call newconf1bb(idum,dihang_in(1,1,1,index),nran,i1)
2679 parent(1,index)=iseed
2684 call check_old(icheck,index)
2685 if(icheck.eq.1) goto 101
2689 !-----------------------------------------
2697 parent(1,index)=iseed
2701 nss_in(index)=bvar_nss(iseed)
2702 do ij=1,nss_in(index)
2703 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2704 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2711 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2717 !-----------------------------------------
2724 theta(j+1)=bvar(1,j,k,iseed)
2725 phi(j+2)=bvar(2,j,k,iseed)
2726 alph(j)=bvar(3,j,k,iseed)
2727 omeg(j)=bvar(4,j,k,iseed)
2732 !d write(iout,*) 'makevar DYNSS',iseed,'#',bvar_ns(iseed),
2733 !d & (bvar_s(k,iseed),k=1,bvar_ns(iseed)),
2734 !d & bvar_nss(iseed),
2735 !d & (bvar_ss(1,k,iseed)-nres,'-',
2736 !d & bvar_ss(2,k,iseed)-nres,k=1,bvar_nss(iseed))
2738 do i1=1,bvar_ns(iseed)
2740 ! N10 fussion of free halfcysteines in seed
2741 ! first select CYS with distance < 7A
2743 do j1=i1+1,bvar_ns(iseed)
2744 if (dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres) &
2746 iabs(bvar_s(i1,iseed)-bvar_s(j1,iseed)).gt.3) then
2750 parent(1,index)=iseed
2752 do ij=1,bvar_nss(iseed)
2753 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2754 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2756 ij=bvar_nss(iseed)+1
2758 iss_in(ij,index)=bvar_s(i1,iseed)+nres
2759 jss_in(ij,index)=bvar_s(j1,iseed)+nres
2761 !d write(iout,*) 'makevar NSS0',index,
2762 !d & dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres),
2763 !d & nss_in(index),iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres
2768 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2776 ! N11 type I transdisulfidation
2778 do j1=1,bvar_nss(iseed)
2779 if (dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)) &
2781 iabs(bvar_s(i1,iseed)-(bvar_ss(1,j1,iseed)-nres)) &
2786 parent(1,index)=iseed
2788 do ij=1,bvar_nss(iseed)
2790 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2791 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2794 nss_in(index)=bvar_nss(iseed)
2795 iss_in(j1,index)=bvar_s(i1,iseed)+nres
2796 jss_in(j1,index)=bvar_ss(1,j1,iseed)
2797 if (iss_in(j1,index).gt.jss_in(j1,index)) then
2798 iss_in(j1,index)=bvar_ss(1,j1,iseed)
2799 jss_in(j1,index)=bvar_s(i1,iseed)+nres
2802 !d write(iout,*) 'makevar NSS1 #1',index,
2803 !d & bvar_s(i1,iseed),bvar_ss(1,j1,iseed)-nres,
2804 !d & dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)),
2805 !d & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
2806 !d & ij=1,nss_in(index))
2811 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2816 if (dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)) &
2818 iabs(bvar_s(i1,iseed)-(bvar_ss(2,j1,iseed)-nres)) &
2823 parent(1,index)=iseed
2825 do ij=1,bvar_nss(iseed)
2827 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2828 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2831 nss_in(index)=bvar_nss(iseed)
2832 iss_in(j1,index)=bvar_s(i1,iseed)+nres
2833 jss_in(j1,index)=bvar_ss(2,j1,iseed)
2834 if (iss_in(j1,index).gt.jss_in(j1,index)) then
2835 iss_in(j1,index)=bvar_ss(2,j1,iseed)
2836 jss_in(j1,index)=bvar_s(i1,iseed)+nres
2840 !d write(iout,*) 'makevar NSS1 #2',index,
2841 !d & bvar_s(i1,iseed),bvar_ss(2,j1,iseed)-nres,
2842 !d & dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)),
2843 !d & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
2844 !d & ij=1,nss_in(index))
2849 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2859 ! N12 type II transdisulfidation
2861 do i1=1,bvar_nss(iseed)
2862 do j1=i1+1,bvar_nss(iseed)
2863 if (dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)) &
2865 dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)) &
2867 iabs(bvar_ss(1,i1,iseed)-bvar_ss(1,j1,iseed)) &
2869 iabs(bvar_ss(2,i1,iseed)-bvar_ss(2,j1,iseed)) &
2873 parent(1,index)=iseed
2875 do ij=1,bvar_nss(iseed)
2876 if (ij.ne.i1 .and. ij.ne.j1) then
2877 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2878 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2881 nss_in(index)=bvar_nss(iseed)
2882 iss_in(i1,index)=bvar_ss(1,i1,iseed)
2883 jss_in(i1,index)=bvar_ss(1,j1,iseed)
2884 if (iss_in(i1,index).gt.jss_in(i1,index)) then
2885 iss_in(i1,index)=bvar_ss(1,j1,iseed)
2886 jss_in(i1,index)=bvar_ss(1,i1,iseed)
2888 iss_in(j1,index)=bvar_ss(2,i1,iseed)
2889 jss_in(j1,index)=bvar_ss(2,j1,iseed)
2890 if (iss_in(j1,index).gt.jss_in(j1,index)) then
2891 iss_in(j1,index)=bvar_ss(2,j1,iseed)
2892 jss_in(j1,index)=bvar_ss(2,i1,iseed)
2896 !d write(iout,*) 'makevar NSS2 #1',index,
2897 !d & bvar_ss(1,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres,
2898 !d & dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)),
2899 !d & bvar_ss(2,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres,
2900 !d & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)),
2901 !d & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
2902 !d & ij=1,nss_in(index))
2907 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2914 if (dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)) &
2916 dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)) &
2918 iabs(bvar_ss(1,i1,iseed)-bvar_ss(2,j1,iseed)) &
2920 iabs(bvar_ss(2,i1,iseed)-bvar_ss(1,j1,iseed)) &
2924 parent(1,index)=iseed
2926 do ij=1,bvar_nss(iseed)
2927 if (ij.ne.i1 .and. ij.ne.j1) then
2928 iss_in(ij,index)=bvar_ss(1,ij,iseed)
2929 jss_in(ij,index)=bvar_ss(2,ij,iseed)
2932 nss_in(index)=bvar_nss(iseed)
2933 iss_in(i1,index)=bvar_ss(1,i1,iseed)
2934 jss_in(i1,index)=bvar_ss(2,j1,iseed)
2935 if (iss_in(i1,index).gt.jss_in(i1,index)) then
2936 iss_in(i1,index)=bvar_ss(2,j1,iseed)
2937 jss_in(i1,index)=bvar_ss(1,i1,iseed)
2939 iss_in(j1,index)=bvar_ss(2,i1,iseed)
2940 jss_in(j1,index)=bvar_ss(1,j1,iseed)
2941 if (iss_in(j1,index).gt.jss_in(j1,index)) then
2942 iss_in(j1,index)=bvar_ss(1,j1,iseed)
2943 jss_in(j1,index)=bvar_ss(2,i1,iseed)
2947 !d write(iout,*) 'makevar NSS2 #2',index,
2948 !d & bvar_ss(1,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres,
2949 !d & dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)),
2950 !d & bvar_ss(2,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres,
2951 !d & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)),
2952 !d & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
2953 !d & ij=1,nss_in(index))
2958 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
2969 ! N13 removal of disulfide bond
2971 if (bvar_nss(iseed).gt.0) then
2972 i1=bvar_nss(iseed)*ran1(idum)+1
2976 parent(1,index)=iseed
2979 do j1=1,bvar_nss(iseed)
2982 iss_in(ij,index)=bvar_ss(1,j1,iseed)
2983 jss_in(ij,index)=bvar_ss(2,j1,iseed)
2986 nss_in(index)=bvar_nss(iseed)-1
2988 !d write(iout,*) 'NSS3',index,i1,
2989 !d & bvar_ss(1,i1,iseed)-nres,'=',bvar_ss(2,i1,iseed)-nres,'#',
2990 !d & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
2991 !d & ij=1,nss_in(index))
2996 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
3005 !-----------------------------------------
3009 if(index.ne.n) write(iout,*)'make_var : ntry=',index
3013 !d write (istat,*) "======== ii=",ii," the dihang array"
3015 !d write (istat,'(i5,4f15.5)') i,(dihang_in(k,i,1,ii)*rad2deg,k=1,4)
3019 end subroutine make_var
3020 !-----------------------------------------------------------------------------
3021 subroutine check_old(icheck,n)
3023 ! implicit real*8 (a-h,o-z)
3024 ! include 'DIMENSIONS'
3025 ! include 'COMMON.CSA'
3026 ! include 'COMMON.BANK'
3027 ! include 'COMMON.CHAIN'
3028 ! include 'COMMON.GEO'
3029 integer :: icheck,n,i1,i2,m,j,i
3030 real(kind=8) :: ctdif,ctdiff,diff,dif
3041 dif=rad2deg*dabs(dihang_in(i,j,m,i1)-dihang_in(i,j,m,i2))
3042 if(dif.gt.180.0) dif=360.0-dif
3043 if(dif.gt.ctdif) goto 100
3045 if(diff.gt.ctdiff) goto 100
3057 end subroutine check_old
3058 !-----------------------------------------------------------------------------
3059 subroutine newconf1rr(idum,vvar,nran,i1)
3061 ! implicit real*8 (a-h,o-z)
3062 ! include 'DIMENSIONS'
3063 ! include 'COMMON.IOUNITS'
3064 ! include 'COMMON.CSA'
3065 ! include 'COMMON.BANK'
3066 ! include 'COMMON.CHAIN'
3067 ! include 'COMMON.GEO'
3068 ! real(kind=4) :: ran1,ran2
3069 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3070 integer,dimension(ntotal) :: iold
3071 integer :: i,j,k,idum,nran,i1,iran,index,number,iter,ind
3072 real(kind=8) :: ctdif,dif
3079 vvar(i,j,k)=rvar(i,j,k,iseed)
3092 10 iran= ran1(idum)*number+1
3093 if(iter.gt.number) return
3095 if(iter.eq.1) goto 11
3097 if(iran.eq.iold(ind)) goto 10
3101 do ind=1,ngroup(iran)
3102 i=igroup(1,ind,iran)
3103 j=igroup(2,ind,iran)
3104 k=igroup(3,ind,iran)
3105 dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
3106 if(dif.gt.180.) dif=360.-dif
3107 if(dif.gt.ctdif) goto 20
3109 if(iter.gt.number) goto 20
3112 do ind=1,ngroup(iran)
3113 i=igroup(1,ind,iran)
3114 j=igroup(2,ind,iran)
3115 k=igroup(3,ind,iran)
3116 vvar(i,j,k)=rvar(i,j,k,i1)
3122 end subroutine newconf1rr
3123 !-----------------------------------------------------------------------------
3124 subroutine newconf1br(idum,vvar,nran,i1)
3126 use energy_data, only: ndih_nconstr,idih_nconstr
3127 use control_data, only: i2ndstr
3128 ! implicit real*8 (a-h,o-z)
3129 ! include 'DIMENSIONS'
3130 ! include 'COMMON.IOUNITS'
3131 ! include 'COMMON.CSA'
3132 ! include 'COMMON.BANK'
3133 ! include 'COMMON.CHAIN'
3134 ! include 'COMMON.GEO'
3135 ! include 'COMMON.TORCNSTR'
3136 ! include 'COMMON.CONTROL'
3137 ! real(kind=4) :: ran1,ran2
3138 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3139 integer,dimension(ntotal) :: iold
3140 integer :: i,j,k,idum,nran,i1,iran,index,number,iter,juhc,ind
3141 real(kind=8) :: ctdif,dif,rtmp
3148 vvar(i,j,k)=bvar(i,j,k,iseed)
3161 10 iran= ran1(idum)*number+1
3162 if(i2ndstr.gt.0) then
3164 if(rtmp.le.rdih_bias) then
3167 if(igroup(2,1,iran).eq.idih_nconstr(j))i=j
3172 iran= ran1(idum)*number+1
3175 if(igroup(2,1,iran).eq.idih_nconstr(j))i=j
3177 if(i.eq.0.or.juhc.lt.1000)goto 4321
3178 if(juhc.eq.1000) then
3179 print *, 'move 6 : failed to find unconstrained group'
3180 write(iout,*) 'move 6 : failed to find unconstrained group'
3185 if(iter.gt.number) return
3187 if(iter.eq.1) goto 11
3189 if(iran.eq.iold(ind)) goto 10
3193 do ind=1,ngroup(iran)
3194 i=igroup(1,ind,iran)
3195 j=igroup(2,ind,iran)
3196 k=igroup(3,ind,iran)
3197 dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
3198 if(dif.gt.180.) dif=360.-dif
3199 if(dif.gt.ctdif) goto 20
3201 if(iter.gt.number) goto 20
3204 do ind=1,ngroup(iran)
3205 i=igroup(1,ind,iran)
3206 j=igroup(2,ind,iran)
3207 k=igroup(3,ind,iran)
3208 vvar(i,j,k)=rvar(i,j,k,i1)
3214 end subroutine newconf1br
3215 !-----------------------------------------------------------------------------
3216 subroutine newconf1bb(idum,vvar,nran,i1)
3218 ! implicit real*8 (a-h,o-z)
3219 ! include 'DIMENSIONS'
3220 ! include 'COMMON.IOUNITS'
3221 ! include 'COMMON.CSA'
3222 ! include 'COMMON.BANK'
3223 ! include 'COMMON.CHAIN'
3224 ! include 'COMMON.GEO'
3225 ! real(kind=4) :: ran1,ran2
3226 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3227 integer,dimension(ntotal) :: iold
3228 integer :: i,j,k,idum,nran,i1,iran,index,number,iter,ind
3229 real(kind=8) :: ctdif,dif
3236 vvar(i,j,k)=bvar(i,j,k,iseed)
3249 10 iran= ran1(idum)*number+1
3250 if(iter.gt.number) return
3252 if(iter.eq.1) goto 11
3254 if(iran.eq.iold(ind)) goto 10
3258 do ind=1,ngroup(iran)
3259 i=igroup(1,ind,iran)
3260 j=igroup(2,ind,iran)
3261 k=igroup(3,ind,iran)
3262 dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
3263 if(dif.gt.180.) dif=360.-dif
3264 if(dif.gt.ctdif) goto 20
3266 if(iter.gt.number) goto 20
3269 do ind=1,ngroup(iran)
3270 i=igroup(1,ind,iran)
3271 j=igroup(2,ind,iran)
3272 k=igroup(3,ind,iran)
3273 vvar(i,j,k)=bvar(i,j,k,i1)
3279 end subroutine newconf1bb
3280 !-----------------------------------------------------------------------------
3281 subroutine newconf1arr(idum,vvar,nran,i1)
3283 ! implicit real*8 (a-h,o-z)
3284 ! include 'DIMENSIONS'
3285 ! include 'COMMON.IOUNITS'
3286 ! include 'COMMON.CSA'
3287 ! include 'COMMON.BANK'
3288 ! include 'COMMON.CHAIN'
3289 ! include 'COMMON.GEO'
3290 ! real(kind=4) :: ran1,ran2
3291 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3292 integer,dimension(ntotal) :: iold
3293 integer :: i,j,k,idum,nran,i1,iran,index,number,iter,ind
3294 real(kind=8) :: ctdif,dif
3301 vvar(i,j,k)=rvar(i,j,k,iseed)
3314 10 iran= ran1(idum)*number+1
3315 if(iter.gt.number) return
3317 if(iter.eq.1) goto 11
3319 if(iran.eq.iold(ind)) goto 10
3323 do ind=1,ngroup(iran)
3324 i=igroup(1,ind,iran)
3325 j=igroup(2,ind,iran)
3326 k=igroup(3,ind,iran)
3327 dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
3328 if(dif.gt.180.) dif=360.-dif
3329 if(dif.gt.ctdif) goto 20
3331 if(iter.gt.number) goto 20
3334 do ind=1,ngroup(iran)
3335 i=igroup(1,ind,iran)
3336 j=igroup(2,ind,iran)
3337 k=igroup(3,ind,iran)
3338 vvar(i,j,k)=rvar(i,j,k,i1)
3344 end subroutine newconf1arr
3345 !-----------------------------------------------------------------------------
3346 subroutine newconf1abr(idum,vvar,nran,i1)
3348 use energy_data, only: ndih_nconstr,idih_nconstr
3349 use control_data, only: i2ndstr
3350 ! implicit real*8 (a-h,o-z)
3351 ! include 'DIMENSIONS'
3352 ! include 'COMMON.IOUNITS'
3353 ! include 'COMMON.CSA'
3354 ! include 'COMMON.BANK'
3355 ! include 'COMMON.CHAIN'
3356 ! include 'COMMON.GEO'
3357 ! include 'COMMON.TORCNSTR'
3358 ! include 'COMMON.CONTROL'
3359 ! real(kind=4) :: ran1,ran2
3360 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3361 integer,dimension(ntotal) :: iold
3362 integer :: i,j,k,idum,nran,i1,iran,index,number,iter,ind
3363 real(kind=8) :: ctdif,dif,rtmp
3370 vvar(i,j,k)=bvar(i,j,k,iseed)
3383 10 iran= ran1(idum)*number+1
3384 if(i2ndstr.gt.0) then
3386 if(rtmp.le.rdih_bias) then
3387 iran=ran1(idum)*ndih_nconstr+1
3388 iran=idih_nconstr(iran)
3391 if(iter.gt.number) return
3393 if(iter.eq.1) goto 11
3395 if(iran.eq.iold(ind)) goto 10
3399 do ind=1,ngroup(iran)
3400 i=igroup(1,ind,iran)
3401 j=igroup(2,ind,iran)
3402 k=igroup(3,ind,iran)
3403 dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
3404 if(dif.gt.180.) dif=360.-dif
3405 if(dif.gt.ctdif) goto 20
3407 if(iter.gt.number) goto 20
3410 do ind=1,ngroup(iran)
3411 i=igroup(1,ind,iran)
3412 j=igroup(2,ind,iran)
3413 k=igroup(3,ind,iran)
3414 vvar(i,j,k)=rvar(i,j,k,i1)
3420 end subroutine newconf1abr
3421 !-----------------------------------------------------------------------------
3422 subroutine newconf1abb(idum,vvar,nran,i1)
3424 use energy_data, only: ndih_nconstr,idih_nconstr
3425 use control_data, only: i2ndstr
3426 ! implicit real*8 (a-h,o-z)
3427 ! include 'DIMENSIONS'
3428 ! include 'COMMON.IOUNITS'
3429 ! include 'COMMON.CSA'
3430 ! include 'COMMON.BANK'
3431 ! include 'COMMON.CHAIN'
3432 ! include 'COMMON.GEO'
3433 ! include 'COMMON.TORCNSTR'
3434 ! include 'COMMON.CONTROL'
3435 ! real(kind=4) :: ran1,ran2
3436 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3437 integer,dimension(ntotal) :: iold
3438 integer :: i,j,k,idum,nran,i1,iran,index,number,iter,ind
3439 real(kind=8) :: ctdif,dif,rtmp
3446 vvar(i,j,k)=bvar(i,j,k,iseed)
3459 10 iran= ran1(idum)*number+1
3460 if(i2ndstr.gt.0) then
3462 if(rtmp.le.rdih_bias) then
3463 iran=ran1(idum)*ndih_nconstr+1
3464 iran=idih_nconstr(iran)
3467 if(iter.gt.number) return
3469 if(iter.eq.1) goto 11
3471 if(iran.eq.iold(ind)) goto 10
3475 do ind=1,ngroup(iran)
3476 i=igroup(1,ind,iran)
3477 j=igroup(2,ind,iran)
3478 k=igroup(3,ind,iran)
3479 dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
3480 if(dif.gt.180.) dif=360.-dif
3481 if(dif.gt.ctdif) goto 20
3483 if(iter.gt.number) goto 20
3486 do ind=1,ngroup(iran)
3487 i=igroup(1,ind,iran)
3488 j=igroup(2,ind,iran)
3489 k=igroup(3,ind,iran)
3490 vvar(i,j,k)=bvar(i,j,k,i1)
3496 end subroutine newconf1abb
3497 !-----------------------------------------------------------------------------
3498 subroutine newconf_residue(idum,vvar,i1,isize)
3500 use energy_data, only: ndih_nconstr,idih_nconstr
3501 use control_data, only: i2ndstr
3504 ! implicit real*8 (a-h,o-z)
3505 ! include 'DIMENSIONS'
3506 ! include 'COMMON.IOUNITS'
3507 ! include 'COMMON.CSA'
3508 ! include 'COMMON.BANK'
3509 ! include 'COMMON.CHAIN'
3510 ! include 'COMMON.GEO'
3511 ! include 'COMMON.TORCNSTR'
3512 ! include 'COMMON.CONTROL'
3513 ! real(kind=4) :: ran1,ran2
3514 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3515 integer,dimension(ntotal) :: iold
3516 integer :: i,j,k,idum,i1,isize,iran,number,iter,ind,iend,istart,&
3518 real(kind=8) :: ctdif,dif,rtmp
3522 if (iseed.gt.mxio .or. iseed.lt.1) then
3523 write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
3524 call mpi_abort(mpi_comm_world,ierror,ierrcode)
3529 vvar(i,j,k)=bvar(i,j,k,iseed)
3538 10 iran= ran1(idum)*number+1
3539 if(i2ndstr.gt.0) then
3541 if(rtmp.le.rdih_bias) then
3542 iran=ran1(idum)*ndih_nconstr+1
3543 iran=idih_nconstr(iran)
3548 if(istart.lt.2) istart=2
3549 if(iend.gt.nres-1) iend=nres-1
3551 if(iter.eq.1) goto 11
3553 if(iran.eq.iold(ind)) goto 10
3559 dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
3560 if(dif.gt.180.) dif=360.-dif
3561 if(dif.gt.ctdif) goto 20
3566 if(iter.gt.number) goto 20
3572 vvar(i,j,k)=bvar(i,j,k,i1)
3577 end subroutine newconf_residue
3578 !-----------------------------------------------------------------------------
3579 subroutine newconf_copy(idum,vvar,i1,istart,iend)
3583 ! implicit real*8 (a-h,o-z)
3584 ! include 'DIMENSIONS'
3585 ! include 'COMMON.IOUNITS'
3586 ! include 'COMMON.CSA'
3587 ! include 'COMMON.BANK'
3588 ! include 'COMMON.CHAIN'
3589 ! include 'COMMON.GEO'
3590 ! include 'COMMON.TORCNSTR'
3591 ! include 'COMMON.CONTROL'
3592 ! real(kind=4) :: ran1,ran2
3593 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3594 integer,dimension(ntotal) :: iold
3595 integer :: i,j,k,idum,i1,istart,iend,ierror,ierrcode
3596 real(kind=8) :: ctdif,dif
3600 if (iseed.gt.mxio .or. iseed.lt.1) then
3601 write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
3602 call mpi_abort(mpi_comm_world,ierror,ierrcode)
3607 vvar(i,j,k)=bvar(i,j,k,iseed)
3615 vvar(i,j,1)=bvar(i,j,1,i1)
3620 end subroutine newconf_copy
3621 !-----------------------------------------------------------------------------
3622 subroutine newconf_residue_hairpin(idum,vvar,i1,fail)
3625 ! use random, only: iran_num
3627 use compare, only:hairpin
3630 ! implicit real*8 (a-h,o-z)
3631 ! include 'DIMENSIONS'
3632 ! include 'COMMON.IOUNITS'
3633 ! include 'COMMON.CSA'
3634 ! include 'COMMON.BANK'
3635 ! include 'COMMON.CHAIN'
3636 ! include 'COMMON.GEO'
3637 ! include 'COMMON.VAR'
3638 ! real(kind=4) :: ran1,ran2
3639 real(kind=8),dimension(mxang,nres,mxch) :: vvar !(mxang,maxres,mxch)
3640 integer,dimension(ntotal) :: iold
3641 integer :: nharp,iharp(4,nres/3),icipa(nres/3)
3642 logical :: fail,not_done
3643 integer :: idum,i,j,k,i1,iend,istart,iii,n_used,icount,iih,&
3645 real(kind=8) :: ctdif,dif
3650 if (iseed.gt.mxio .or. iseed.lt.1) then
3651 write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
3652 call mpi_abort(mpi_comm_world,ierror,ierrcode)
3657 vvar(i,j,k)=bvar(i,j,k,iseed)
3663 theta(j+1)=bvar(1,j,k,i1)
3664 phi(j+2)=bvar(2,j,k,i1)
3665 alph(j)=bvar(3,j,k,i1)
3666 omeg(j)=bvar(4,j,k,i1)
3671 call hairpin(.false.,nharp,iharp)
3673 if (nharp.eq.0) then
3686 iih=iran_num(1,nharp)
3688 if (iih.eq.icipa(k)) then
3697 not_done = not_done .and. icount.le.nharp
3701 write (iout,*) "CHUJ NASTAPIL W NEWCONF_RESIDUE_HAIRPIN!!!!"
3706 istart=iharp(1,iih)+1
3709 !dd write (iout,*) "newconf_residue_hairpin: iih",iih,
3710 !dd & " istart",istart," iend",iend
3715 dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
3716 if(dif.gt.180.) dif=360.-dif
3717 if(dif.gt.ctdif) goto 20
3726 vvar(i,j,k)=bvar(i,j,k,i1)
3732 ! write (iout,'(4f8.3)') (rad2deg*vvar(i,l,j),i=1,4)
3742 end subroutine newconf_residue_hairpin
3743 !-----------------------------------------------------------------------------
3744 subroutine gen_hairpin
3748 use compare, only:hairpin
3749 ! implicit real*8 (a-h,o-z)
3750 ! include 'DIMENSIONS'
3751 ! include 'COMMON.IOUNITS'
3752 ! include 'COMMON.CSA'
3753 ! include 'COMMON.BANK'
3754 ! include 'COMMON.CHAIN'
3755 ! include 'COMMON.GEO'
3756 ! include 'COMMON.VAR'
3757 ! include 'COMMON.HAIRPIN'
3758 integer :: i1,j,k,iters
3760 ! write (iout,*) 'Entering GEN_HAIRPIN'
3765 theta(j+1)=bvar(1,j,k,i1)
3766 phi(j+2)=bvar(2,j,k,i1)
3767 alph(j)=bvar(3,j,k,i1)
3768 omeg(j)=bvar(4,j,k,i1)
3772 call hairpin(.false.,nharp_seed(iters),iharp_seed(1,1,iters))
3777 nharp_tot=nharp_tot+nharp_seed(iters)
3778 nharp_use(iters)=4*nharp_seed(iters)
3779 do j=1,nharp_seed(iters)
3780 iharp_use(0,j,iters)=4
3782 iharp_use(k,j,iters)=0
3787 write (iout,*) 'GEN_HAIRPIN: nharp_tot',nharp_tot
3789 !dd write (iout,*) 'seed',i
3790 !dd write (iout,*) 'nharp_seed',nharp_seed(i),
3791 !dd & ' nharp_use',nharp_use(i)
3792 !d write (iout,*) 'iharp_seed, iharp_use'
3793 !d do j=1,nharp_seed(i)
3794 !d write (iout,'(7i3)') iharp_seed(1,j,i),iharp_seed(2,j,i),
3795 !d & (iharp_use(k,j,i),k=0,4)
3799 end subroutine gen_hairpin
3800 !-----------------------------------------------------------------------------
3801 subroutine select_frag(nn,nh,nl,ns,nb,i_csa)
3806 ! implicit real*8 (a-h,o-z)
3807 ! include 'DIMENSIONS'
3808 ! include 'COMMON.IOUNITS'
3809 ! include 'COMMON.CSA'
3810 ! include 'COMMON.BANK'
3811 ! include 'COMMON.CHAIN'
3812 ! include 'COMMON.GEO'
3813 ! include 'COMMON.VAR'
3814 ! include 'COMMON.HAIRPIN'
3815 ! include 'COMMON.DISTFIT'
3816 character(len=50) :: linia
3817 integer :: isec(nres)
3818 integer :: i,j,i1,k,nn,nh,nl,ns,nb,i_csa,nl1,ns1
3825 !d write (iout,*) 'Entering select_frag'
3832 theta(j+1)=bvar(1,j,k,i1)
3833 phi(j+2)=bvar(2,j,k,i1)
3834 alph(j)=bvar(3,j,k,i1)
3835 omeg(j)=bvar(4,j,k,i1)
3839 !d write (iout,*) ' -- ',i1,' -- '
3840 call secondary2(.false.)
3842 ! bvar_frag nn==pair of nonlocal strands in beta sheet (loop>4)
3843 ! strands > 4 residues; used by N7 and N16
3847 !test 09/12/02 bfrag(2,j)-bfrag(1,j).gt.3
3849 do i=bfrag(1,j),bfrag(2,j)
3852 do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j))
3856 if ( (bfrag(3,j).lt.bfrag(4,j) .or. &
3857 bfrag(4,j)-bfrag(2,j).gt.4) .and. &
3858 bfrag(2,j)-bfrag(1,j).gt.4 ) then
3862 if (bfrag(3,j).lt.bfrag(4,j)) then
3863 write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') &
3864 "select",bfrag(1,j)-1,"-",bfrag(2,j)-1,&
3865 ",",bfrag(3,j)-1,"-",bfrag(4,j)-1
3867 write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') &
3868 "select",bfrag(1,j)-1,"-",bfrag(2,j)-1,&
3869 ",",bfrag(4,j)-1,"-",bfrag(3,j)-1
3872 !d call write_pdb(i_csa*1000+nn+nh,linia,0d0)
3877 bvar_frag(nn,i+2)=bfrag(i,j)
3883 ! hvar_frag nh==helices; used by N8 and N9
3887 do i=hfrag(1,j),hfrag(2,j)
3891 if ( hfrag(2,j)-hfrag(1,j).gt.4 ) then
3894 !d write(linia,'(a6,i3,a1,i3)')
3895 !d & "select",hfrag(1,j)-1,"-",hfrag(2,j)-1
3896 !d call write_pdb(i_csa*1000+nn+nh,linia,0d0)
3899 hvar_frag(nh,2)=hfrag(1,j)
3900 hvar_frag(nh,3)=hfrag(2,j)
3905 !v write(iout,'(i4,1pe12.4,1x,1000i1)')
3906 !v & i1,bene(i1),(isec(i),i=1,nres)
3907 !v write(linia,'(i4,1x,1000i1)')
3908 !v & i1,(isec(i),i=1,nres)
3909 !v call write_pdb(i_csa*1000+i1,linia,bene(i1))
3911 ! lvar_frag nl==loops; used by N14
3915 do while (i.lt.nres)
3916 if (isec(i).eq.0) then
3921 do while (isec(i).eq.0.and.i.le.nres)
3925 if (lvar_frag(nl,3)-lvar_frag(nl,2).lt.1) nl=nl-1
3929 !d write(iout,'(4i5)') (i,(lvar_frag(i,ii),ii=1,3),i=nl1+1,nl)
3932 ! svar_frag ns==an secondary structure element; used by N15
3936 do while (i.lt.nres)
3937 if (isec(i).gt.0) then
3942 do while (isec(i).gt.0.and.isec(i-1).eq.isec(i) &
3947 if (svar_frag(ns,3)-svar_frag(ns,2).lt.1) ns=ns-1
3949 if (isec(i).eq.0) i=i+1
3951 !d write(iout,'(4i5)') (i,(svar_frag(i,ii),ii=1,3),i=ns1+1,ns)
3954 ! avar_frag nb==any pair of beta strands; used by N17
3960 avar_frag(nb,i+1)=bfrag(i,j)
3967 end subroutine select_frag
3968 !-----------------------------------------------------------------------------
3970 !-----------------------------------------------------------------------------
3973 ! feeds tasks for parallel processing
3976 use control_data, only: vdisulf
3978 use io, only:from_int,write_csa_pdb
3979 ! implicit real*8 (a-h,o-z)
3980 ! include 'DIMENSIONS'
3982 ! real(kind=4) :: ran1,ran2
3983 ! include 'COMMON.CSA'
3984 ! include 'COMMON.BANK'
3985 ! include 'COMMON.IOUNITS'
3986 ! include 'COMMON.CHAIN'
3987 ! include 'COMMON.TIME1'
3988 ! include 'COMMON.SETUP'
3989 ! include 'COMMON.VAR'
3990 ! include 'COMMON.GEO'
3991 ! include 'COMMON.CONTROL'
3992 ! include 'COMMON.SBRIDGE'
3993 real(kind=4) :: tcpu
3994 real(kind=8) :: time_start,time_start_c,time0f,time0i
3995 logical :: ovrtim,sync_iter,timeout,flag,timeout1
3996 integer,dimension(mpi_status_size) :: muster
3997 real(kind=8),dimension(0:100) :: t100
3998 integer,dimension(mxio) :: indx
3999 real(kind=8),dimension(6*nres) :: xout !(maxvar) (maxvar=6*maxres)
4000 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
4001 integer,dimension(9) :: ind
4002 real(kind=8),dimension(2) :: cout
4003 real(kind=8),parameter :: rad=1.745329252d-2
4005 integer :: i,m,j,jlee,nft,idum,nrmsdb,nrmsdb1,ierr,ierror,ierrcode,&
4006 ntrial,ntry,idum2,imax,idumm,nconfr,iconf,mm,k,im,nst,ifar,&
4007 iter,irecv,isent,iw_pdb,nft0i,nft00_c,nft00,ifrom,ij,&
4009 real(kind=8) :: adif,p_cut,cutdifr,rmsdbc1c,time1i,ctdif1,xctdif,&
4011 !ccccccccccccccccccccccccccccccccccccccccccccccc
4012 sync_iter=.true. !el
4015 IF (ME.EQ.KING) THEN
4028 if(iref.ne.0) call from_int(1,0,idum)
4030 ! To minimize input conformation (bank conformation)
4031 ! Output to $mol.reminimized
4032 if (irestart.lt.0) then
4033 call read_bank(0,nft,cutdifr)
4034 if (irestart.lt.-10) then
4036 call prune_bank(p_cut)
4039 call reminimize(jlee)
4043 if (irestart.eq.0) then
4047 if (ntbankm.eq.0) ntbank=0
4056 !!bankt call read_bankt(jlee,nft,cutdifr)
4057 call read_bank(jlee,nft,cutdifr)
4058 call read_rbank(jlee,adif)
4059 if(iref.ne.0) call from_int(1,0,idum)
4063 ntrial=n1+n2+n3+n4+n5+n6+n7+n8
4067 ! ntrial : number of trial conformations per seed.
4068 ! ntry : total number of trial conformations including seed conformations.
4075 call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr)
4076 !ccccccccccccccccccccccccccccccccccccccc
4078 !ccccccccccccccccccccccccccccccccccccccc
4080 IF (ME.EQ.KING) THEN
4081 if(sync_iter) goto 333
4082 idum=- ran2(idum2)*imax
4083 if(jlee.lt.jstart) goto 300
4085 ! Restart the random number generator for conformation generation
4087 if(irestart.gt.0) then
4089 if(idum2.le.0) idum2=-idum2+1
4090 idum=- ran2(idum2)*imax
4096 open(icsa_seed,file=csa_seed,status="old")
4097 write(icsa_seed,*) "jlee : ",jlee
4101 write(icsa_history,*) "number of procs is ",nodes
4102 write(icsa_history,*) jlee,idum,idum2
4105 !ccccccccccccccccccccccccccccccccccccccccccccccc
4109 write(icsa_history,*) "nbank is ",nbank
4112 if(irestart.eq.1) goto 111
4113 if(irestart.eq.2) then
4118 do i=nbank+1,nbank+nconf
4123 ! start energy minimization
4124 nconfr=max0(nconf+nadd,nodes-1)
4125 if (sync_iter) nconf_in=0
4126 ! king-emperor - feed input and sort output
4127 write (iout,*) "NCONF_IN",nconf_in
4129 if (nconf_in.gt.0) then
4130 ! al 7/2/00 - added possibility to read in some of the initial conformations
4132 read (intin,'(i5)',end=11,err=12) iconf
4134 write (iout,*) "write READ_ANGLES",iconf,m
4135 call read_angles(intin,*11)
4142 dihang_in(1,j,1,mm)=theta(j+1)
4143 dihang_in(2,j,1,mm)=phi(j+2)
4144 dihang_in(3,j,1,mm)=alph(j)
4145 dihang_in(4,j,1,mm)=omeg(j)
4149 11 write (iout,*) nconf_in," conformations requested, but only",&
4150 m-1," found in the angle file."
4154 write (iout,*) nconf_in,&
4155 " initial conformations have been read in."
4158 if (nconfr.gt.nconf_in) then
4159 call make_ranvar(nconfr,m,idum)
4160 write (iout,*) nconfr-nconf_in,&
4161 " conformations have been generated randomly."
4165 call from_int(nconfr,m,idum)
4166 ! call from_pdb(nconfr,idum)
4168 write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr
4169 write (*,*) 'Exitted from make_ranvar nconfr=',nconfr
4171 write (iout,*) 'Initial conformation',m
4172 write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1)
4173 write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1)
4174 write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1)
4175 write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1)
4177 write(iout,*)'Calling FEEDIN NCONF',nconfr
4179 call feedin(nconfr,nft)
4180 write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i
4182 write(icsa_history,*) jlee,nft,nbank
4183 write(icsa_history,851) (etot(i),i=1,nconfr)
4184 write(icsa_history,850) (rmsn(i),i=1,nconfr)
4185 write(icsa_history,850) (pncn(i),i=1,nconfr)
4186 write(icsa_history,*)
4189 ! To minimize input conformation (bank conformation)
4190 ! Output to $mol.reminimized
4191 if (irestart.lt.0) then
4192 call reminimize(jlee)
4195 if (irestart.eq.1) goto 111
4196 ! soldier - perform energy minimization
4200 !cccccccccccccccccccccccccccccccccc
4201 ! need to syncronize all procs
4202 call mpi_barrier(CG_COMM,ierr)
4204 print *, ' cannot synchronize MPI'
4207 !cccccccccccccccccccccccccccccccccc
4209 IF (ME.EQ.KING) THEN
4211 ! print *,"ok after minim"
4213 if(irestart.eq.2) then
4215 ! ntbank=ntbank+nconf
4216 if(ntbank.gt.ntbankm) ntbank=ntbankm
4218 ! print *,"ok before indexx"
4220 call indexx(nconfr,etot,indx)
4226 call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1))
4227 do k=nconf_in+1,nconfr
4228 indx(k)=indx(k)+nconf_in
4231 ! call indexx(nconfr,rmsn,indx)
4233 ! print *,"ok after indexx"
4236 if (m.gt.mxio .or. m.lt.1) then
4237 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m
4238 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4240 jbank(im+nbank-nconf)=0
4241 bene(im+nbank-nconf)=etot(m)
4242 rene(im+nbank-nconf)=etot(m)
4243 !!bankt btene(im)=etot(m)
4245 brmsn(im+nbank-nconf)=rmsn(m)
4246 bpncn(im+nbank-nconf)=pncn(m)
4247 rrmsn(im+nbank-nconf)=rmsn(m)
4248 rpncn(im+nbank-nconf)=pncn(m)
4249 if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then
4250 write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,&
4251 ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf
4252 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4257 bvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
4258 rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
4259 !!bankt btvar(i,j,k,im)=dihang(i,j,k,m)
4265 if(brmsn(im+nbank-nconf).gt.rmscut.or. &
4266 bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9
4269 bvar_ns(im+nbank-nconf)=ns-2*nss
4273 do while( iss(i).ne.ihpb(j)-nres .and. &
4274 iss(i).ne.jhpb(j)-nres .and. j.le.nss)
4279 bvar_s(k,im+nbank-nconf)=iss(i)
4283 bvar_nss(im+nbank-nconf)=nss
4285 bvar_ss(1,i,im+nbank-nconf)=ihpb(i)
4286 bvar_ss(2,i,im+nbank-nconf)=jhpb(i)
4293 IF (ME.EQ.KING) THEN
4299 if(nbank.eq.nconf.and.irestart.eq.0) then
4306 !d print *,"adif,xctdif,cutdifr"
4307 !d print *,adif,xctdif,cutdifr
4308 nst=ntotal/ntrial/nseed
4309 xctdif=(cutdif/ctdif1)**(-1.0/nst)
4310 if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr)
4311 ! print *,"ok after estimate"
4315 call write_rbank(jlee,adif,nft)
4316 call write_bank(jlee,nft)
4317 !!bankt call write_bankt(jlee,nft)
4318 ! call write_bank1(jlee)
4320 write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1
4321 write(icsa_history,851) (bene(i),i=1,nbank)
4322 write(icsa_history,850) (brmsn(i),i=1,nbank)
4323 write(icsa_history,850) (bpncn(i),i=1,nbank)
4341 if (.not.sync_iter) then
4350 !cccccccccccccccccccccccccccccccccccccc
4351 do while (.not. finished)
4352 !cccccccccccccccccccccccccccccccccccccc
4353 !rc print *,"iter ", iter,' isent=',isent
4355 IF (ME.EQ.KING) THEN
4356 ! start energy minimization
4358 if (isent.eq.0) then
4359 ! king-emperor - select seeds & make var & feed input
4360 !d print *,'generating new conf',ntrial,MPI_WTIME()
4361 call select_is(nseed,ifar,idum)
4363 open(icsa_seed,file=csa_seed,status="old")
4364 write(icsa_seed,39) &
4365 jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
4368 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
4369 ebmin,ebmax,nft,iuse,nbank,ntbank
4374 call make_var(ntry,idum,iter)
4375 !d print *,'new trial generated',ntrial,MPI_WTIME()
4377 write (iout,'(a20,i4,f12.2)') &
4378 'Time for make trial',iter+1,time2i-time1i
4381 !rc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
4382 !rc call feedin(ntry,nft)
4385 if (isent.ge.nodes.or.iter.gt.0) then
4386 !t print *,'waiting ',MPI_WTIME()
4388 call recv(0,ifrom,xout,eout,ind,timeout)
4389 !t print *,' ',irecv,' received from',ifrom,MPI_WTIME()
4394 !t print *,'sending to',ifrom,MPI_WTIME()
4395 call send(isent,ifrom,iter)
4396 !t print *,isent,' sent ',MPI_WTIME()
4398 ! store results -----------------------------------------------
4399 if (isent.ge.nodes.or.iter.gt.0) then
4401 movernx(irecv)=iabs(ind(5))
4402 call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
4406 iss_out(i,irecv)=ihpb(i)
4407 jss_out(i,irecv)=jhpb(i)
4411 call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
4413 !--------------------------------------------------------------
4414 if (isent.eq.ntry) then
4416 write (iout,'(a18,f12.2,a14,f10.2)') &
4417 'Nonsetup time ',time1i-time_start_c,&
4418 ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
4419 write (iout,'(a14,i4,f12.2,a14,f10.2)') &
4420 'Time for iter ',iter+1,time1i-time0i,&
4421 ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
4424 cutdif=cutdif*xctdif
4425 if(cutdif.lt.ctdif1) cutdif=ctdif1
4427 print *,'UPDATING ',ntry-nodes+1,irecv
4428 write(iout,*) 'UPDATING ',ntry-nodes+1
4430 !----------------- call update(ntry-nodes+1) -------------------
4431 nstep=nstep+ntry-nseed-(nodes-1)
4432 call refresh_bank(ntry-nodes+1)
4433 !!bankt call refresh_bankt(ntry-nodes+1)
4435 !----------------- call update(ntry) ---------------------------
4437 print *,'UPDATING ',ntry,irecv
4438 write(iout,*) 'UPDATING ',ntry
4439 nstep=nstep+ntry-nseed
4440 call refresh_bank(ntry)
4441 !!bankt call refresh_bankt(ntry)
4443 !-----------------------------------------------------------------
4445 call write_bank(jlee,nft)
4446 !!bankt call write_bankt(jlee,nft)
4450 write (iout,'(a20,i4,f12.2)') &
4451 'Time for refresh ',iter,time1i-time0i
4453 if(ebmin.lt.estop) finished=.true.
4454 if(icycle.gt.icmax) then
4455 call write_bank1(jlee)
4461 if(nbank.gt.1000) then
4468 if(nstep.gt.nstmax) finished=.true.
4470 if(finished.or.sync_iter) then
4472 call recv(1,ifrom,xout,eout,ind,timeout)
4475 print *,'ERROR worker is not responding'
4476 write(iout,*) 'ERROR worker is not responding'
4477 time1i=MPI_WTIME()-time_start_c
4478 print *,'End of cycle, master time for ',iter,' iters ',&
4479 time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
4480 write (iout,*) 'End of cycle, master time for ',iter,&
4481 ' iters ',time1i,' sec'
4482 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
4483 print *,'UPDATING ',ij-1
4484 write(iout,*) 'UPDATING ',ij-1
4486 call refresh_bank(ij-1)
4487 !!bankt call refresh_bankt(ij-1)
4490 ! print *,'node ',ifrom,' finished ',ij,nft
4491 write(iout,*) 'node ',ifrom,' finished ',ij,nft
4494 movernx(ij)=iabs(ind(5))
4495 call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
4499 iss_out(i,ij)=ihpb(i)
4500 jss_out(i,ij)=jhpb(i)
4504 call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
4507 !rc print *,'---------bcast finished--------',finished
4508 time1i=MPI_WTIME()-time_start_c
4509 print *,'End of cycle, master time for ',iter,' iters ',&
4510 time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
4511 write (iout,*) 'End of cycle, master time for ',iter,&
4512 ' iters ',time1i,' sec'
4513 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
4515 !timeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
4516 !timeout call mpi_bcast(sync_iter,1,mpi_logical,0,
4517 !timeout & CG_COMM,ierr)
4520 call mpi_issend(finished,1,mpi_logical,ij,idchar,&
4522 call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,&
4526 do while(.not. (flag .or. timeout1))
4527 call MPI_TEST(ireq2,flag,muster,ierr)
4529 if(tend1-tstart.gt.60) then
4530 print *,'ERROR worker ',ij,' is not responding'
4531 write(iout,*) 'ERROR worker ',ij,' is not responding'
4536 write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
4539 write(iout,*) 'worker ',ij,' OK ',tend1-tstart
4542 print *,'UPDATING ',nodes-1,ij
4543 write(iout,*) 'UPDATING ',nodes-1
4544 call refresh_bank(nodes-1)
4545 !!bankt call refresh_bankt(nodes-1)
4547 call write_bank(jlee,nft)
4548 !!bankt call write_bankt(jlee,nft)
4553 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
4558 write(iout,*)'### Total stats:'
4560 if(nstatnx_tot(i,1).ne.0) then
4562 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4563 '### N',i,' total=',nstatnx_tot(i,1),&
4564 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',&
4565 (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
4567 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4568 '###N',i,' total=',nstatnx_tot(i,1),&
4569 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',&
4570 (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
4574 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4575 '### N',i,' total=',nstatnx_tot(i,1),&
4576 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),&
4579 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4580 '###N',i,' total=',nstatnx_tot(i,1),&
4581 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),&
4588 if(sync_iter) goto 331
4590 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
4591 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
4593 44 format('jlee =',i3,':',4f10.1,' E =',f8.3,i7,i10)
4599 ! soldier - perform energy minimization
4601 print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
4602 write (iout,*) 'End of minim, proc',me,'time ',&
4603 MPI_WTIME()-time_start
4605 !timeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
4606 !timeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
4607 call mpi_recv(finished,1,mpi_logical,0,idchar,&
4608 CG_COMM,muster,ierr)
4609 call mpi_recv(sync_iter,1,mpi_logical,0,idchar,&
4610 CG_COMM,muster,ierr)
4611 if(sync_iter) goto 331
4614 !cccccccccccccccccccccccccccccccccccccc
4616 !cccccccccccccccccccccccccccccccccccccc
4618 IF (ME.EQ.KING) THEN
4620 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
4621 ebmin,ebmax,nft,iuse,nbank,ntbank
4623 write(icsa_history,44) jlee,0.0,0.0,0.0,&
4625 write(icsa_history,*)
4628 time1i=MPI_WTIME()-time_start
4629 print *,'End of RUN, master time ',&
4630 time1i,'sec, Eval/s ',(nft-nft00)/time1i
4631 write (iout,*) 'End of RUN, master time ',&
4633 write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
4636 write(iout,*) '!!!! ERROR worker was not responding'
4637 write(iout,*) '!!!! cannot finish work normally'
4638 write(iout,*) 'Processor0 is calling MPI_ABORT'
4639 print *,'!!!! ERROR worker was not responding'
4640 print *,'!!!! cannot finish work normally'
4641 print *,'Processor0 is calling MPI_ABORT'
4643 call mpi_abort(mpi_comm_world, 111, ierr)
4647 !ccccccccccccccccccccccccccccc
4649 !ccccccccccccccccccccccccccccc
4652 end subroutine together
4653 !-----------------------------------------------------------------------------
4654 subroutine feedin(nconf,nft)
4657 use geometry_data, only:nvar
4658 use io, only:write_csa_pdb
4659 ! sends out starting conformations and receives results of energy minimization
4660 ! implicit real*8 (a-h,o-z)
4661 ! include 'DIMENSIONS'
4662 ! include 'COMMON.VAR'
4663 ! include 'COMMON.IOUNITS'
4664 ! include 'COMMON.CONTROL'
4666 real(kind=8),dimension(6*nres) :: xin,xout !(maxvar) (maxvar=6*maxres)
4667 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
4668 real(kind=8),dimension(2) :: cout
4669 integer,dimension(9) :: ind
4670 integer,dimension(12) :: info
4671 integer,dimension(mpi_status_size) :: muster
4672 ! include 'COMMON.SETUP'
4673 real(kind=8),parameter :: rad=1.745329252d-2
4674 integer :: j,nconf,nft,mm,n,ierror,ierrcode,ierr,iw_pdb,&
4677 print *,'FEEDIN: NCONF=',nconf
4679 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4680 if (nconf .lt. nodes-1) then
4681 write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',&
4683 write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',&
4685 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4688 ! pull out external and internal variables for next start
4689 call putx(xin,n,rad)
4690 ! write (iout,*) 'XIN from FEEDIN N=',n
4691 ! write(iout,'(8f10.4)') (xin(j),j=1,nvar)
4693 if (mm.lt.nodes) then
4694 ! feed task to soldier
4695 ! print *, ' sending input for start # ',n
4702 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,&
4704 call mpi_send(xin,nvar,mpi_double_precision,mm,&
4705 idreal,CG_COMM,ierr)
4707 ! find an available soldier
4708 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,&
4709 CG_COMM,muster,ierr)
4710 ! print *, ' receiving output from start # ',ind(1)
4711 man=muster(mpi_source)
4712 ! receive final energies and variables
4714 call mpi_recv(eout,1,mpi_double_precision,&
4715 man,idreal,CG_COMM,muster,ierr)
4718 call mpi_recv(co,1,mpi_double_precision,&
4719 man,idreal,CG_COMM,muster,ierr)
4720 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
4722 call mpi_recv(xout,nvar,mpi_double_precision,&
4723 man,idreal,CG_COMM,muster,ierr)
4724 ! print *,nvar , ierr
4725 ! feed next task to soldier
4726 ! print *, ' sending input for start # ',n
4736 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,&
4738 call mpi_send(xin,nvar,mpi_double_precision,man,&
4739 idreal,CG_COMM,ierr)
4740 ! retrieve latest results
4741 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
4743 call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
4746 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4748 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4750 ! wait for a soldier
4751 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,&
4752 CG_COMM,muster,ierr)
4753 !rc if (ierr.ne.0) go to 30
4754 ! print *, ' receiving output from start # ',ind(1)
4755 man=muster(mpi_source)
4756 ! receive final energies and variables
4758 call mpi_recv(eout,1,&
4759 mpi_double_precision,man,idreal,&
4760 CG_COMM,muster,ierr)
4763 call mpi_recv(co,1,mpi_double_precision,&
4764 man,idreal,CG_COMM,muster,ierr)
4765 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
4767 !rc if (ierr.ne.0) go to 30
4768 call mpi_recv(xout,nvar,mpi_double_precision,&
4769 man,idreal,CG_COMM,muster,ierr)
4770 ! print *,nvar , ierr
4771 !rc if (ierr.ne.0) go to 30
4779 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,&
4782 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
4784 call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
4786 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4788 10 print *, ' dispatching error'
4789 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4791 20 print *, ' communication error'
4792 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4794 30 print *, ' receiving error'
4795 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4798 end subroutine feedin
4799 !-----------------------------------------------------------------------------
4800 subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
4804 use compare, only: contact_fract
4807 ! receives and stores data from soldiers
4808 ! implicit real*8 (a-h,o-z)
4809 ! include 'DIMENSIONS'
4810 ! include 'COMMON.IOUNITS'
4811 ! include 'COMMON.CSA'
4812 ! include 'COMMON.BANK'
4813 ! include 'COMMON.VAR'
4814 ! include 'COMMON.CHAIN'
4815 ! include 'COMMON.CONTACTS'
4816 integer,dimension(9) :: ind
4817 real(kind=8),dimension(6*nres) :: xout !(maxvar) (maxvar=6*maxres)
4818 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
4820 real(kind=8) :: przes(3),obr(3,3),cout(2)
4822 integer :: iw_pdb,k,j,ierror,ierrcode
4823 real(kind=8) :: rad,co
4826 if (k.gt.mxio .or. k.lt.1) then
4828 'ERROR - dimensions of ANGMIN have been exceeded K=',k
4829 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4837 ! retrieve dihedral angles etc
4838 call var_to_geom(nvar,xout)
4840 dihang(1,j,1,k)=theta(j+1)
4841 dihang(2,j,1,k)=phi(j+2)
4842 dihang(3,j,1,k)=alph(j)
4843 dihang(4,j,1,k)=omeg(j)
4845 dihang(2,nres-1,1,k)=0.0d0
4849 !d write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
4850 !d & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
4855 ! call dihang_to_c(dihang(1,1,1,k))
4856 ! call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
4857 ! call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
4858 ! call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
4859 ! & nsup,przes,obr,non_conv)
4860 ! rmsn(k)=dsqrt(rms)
4862 call rmsd_csa(rmsn(k))
4863 call contact(.false.,ncont,icont,co)
4864 pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
4866 !d write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
4867 !d & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
4868 !d & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
4869 !d & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
4873 if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
4876 !-----------------------------------------------------------------------------
4877 subroutine putx(xin,n,rad)
4880 ! gets starting variables
4881 ! implicit real*8 (a-h,o-z)
4882 ! include 'DIMENSIONS'
4883 ! include 'COMMON.CSA'
4884 ! include 'COMMON.BANK'
4885 ! include 'COMMON.VAR'
4886 ! include 'COMMON.CHAIN'
4887 ! include 'COMMON.IOUNITS'
4889 real(kind=8),dimension(6*nres) :: xin !(maxvar) (maxvar=6*maxres)
4892 ! pull out starting values for variables
4893 ! write (iout,*)'PUTX: N=',n
4895 ! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
4896 ! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
4897 ! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
4898 ! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
4900 theta(j+1)=dihang_in(1,j,m,n)
4901 phi(j+2)=dihang_in(2,j,m,n)
4902 alph(j)=dihang_in(3,j,m,n)
4903 omeg(j)=dihang_in(4,j,m,n)
4906 ! set up array of variables
4907 call geom_to_var(nvar,xin)
4908 ! write (iout,*) 'xin in PUTX N=',n
4910 ! write (iout,'(8f10.4)') (xin(i),i=1,nvar)
4913 !-----------------------------------------------------------------------------
4914 subroutine putx2(xin,iff,n)
4917 ! gets starting variables
4918 ! implicit real*8 (a-h,o-z)
4919 ! include 'DIMENSIONS'
4920 ! include 'COMMON.CSA'
4921 ! include 'COMMON.BANK'
4922 ! include 'COMMON.VAR'
4923 ! include 'COMMON.CHAIN'
4924 ! include 'COMMON.IOUNITS'
4926 real(kind=8),dimension(6*nres) :: xin !(maxvar) (maxvar=6*maxres)
4927 integer,dimension(nres) :: iff !(maxres)
4929 ! pull out starting values for variables
4932 theta(j+1)=dihang_in2(1,j,m,n)
4933 phi(j+2)=dihang_in2(2,j,m,n)
4934 alph(j)=dihang_in2(3,j,m,n)
4935 omeg(j)=dihang_in2(4,j,m,n)
4938 ! set up array of variables
4939 call geom_to_var(nvar,xin)
4945 end subroutine putx2
4946 !-----------------------------------------------------------------------------
4947 subroutine prune_bank(p_cut)
4950 ! implicit real*8 (a-h,o-z)
4951 ! include 'DIMENSIONS'
4953 ! include 'COMMON.CSA'
4954 ! include 'COMMON.BANK'
4955 ! include 'COMMON.IOUNITS'
4956 ! include 'COMMON.CHAIN'
4957 ! include 'COMMON.TIME1'
4958 ! include 'COMMON.SETUP'
4959 integer :: k,j,i,m,ip,nprune
4960 real(kind=8) :: p_cut,diff,ddmin
4961 !---------------------------
4962 ! This subroutine prunes bank conformations using p_cut
4963 !---------------------------
4971 dihang(i,j,k,nprune)=bvar(i,j,k,m)
4975 bene(nprune)=bene(m)
4976 brmsn(nprune)=brmsn(m)
4977 bpncn(nprune)=bpncn(m)
4982 call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
4983 if(diff.lt.p_cut) goto 100
4984 if(diff.lt.ddmin) ddmin=diff
4990 dihang(i,j,k,nprune)=bvar(i,j,k,m)
4994 bene(nprune)=bene(m)
4995 brmsn(nprune)=brmsn(m)
4996 bpncn(nprune)=bpncn(m)
4998 write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
5001 print *, 'Pruning :',m,nprune,p_cut
5002 call write_bank(0,0)
5005 end subroutine prune_bank
5006 !-----------------------------------------------------------------------------
5007 subroutine reminimize(jlee)
5010 ! implicit real*8 (a-h,o-z)
5011 ! include 'DIMENSIONS'
5013 ! include 'COMMON.CSA'
5014 ! include 'COMMON.BANK'
5015 ! include 'COMMON.IOUNITS'
5016 ! include 'COMMON.CHAIN'
5017 ! include 'COMMON.TIME1'
5018 ! include 'COMMON.SETUP'
5019 integer :: i,j,k,jlee,index,nft,ntry
5020 !---------------------------
5021 ! This subroutine re-minimizes bank conformations:
5022 !---------------------------
5029 if (me.eq.king) then
5030 open(icsa_history,file=csa_history,status="old")
5031 write(icsa_history,*) "Re-minimization",nodes,"nodes"
5032 write(icsa_history,851) (bene(i),i=1,nbank)
5033 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
5034 ebmin,ebmax,nft,iuse,nbank,ntbank
5040 dihang_in(i,j,k,index)=bvar(i,j,k,index)
5046 call feedin(ntry,nft)
5054 if (me.eq.king) then
5056 call replace_bvar(i,i)
5058 open(icsa_history,file=csa_history,status="old")
5059 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
5060 ebmin,ebmax,nft,iuse,nbank,ntbank
5061 write(icsa_history,851) (bene(i),i=1,nbank)
5063 call write_bank_reminimized(jlee,nft)
5066 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
5069 ! 850 format(10f8.3)
5072 end subroutine reminimize
5073 !-----------------------------------------------------------------------------
5074 subroutine send(n,mm,it)
5077 use geometry_data, only: nvar
5078 use control_data, only: vdisulf
5079 ! sends out starting conformation for minimization
5080 ! implicit real*8 (a-h,o-z)
5081 ! include 'DIMENSIONS'
5082 ! include 'COMMON.VAR'
5083 ! include 'COMMON.IOUNITS'
5084 ! include 'COMMON.CONTROL'
5085 ! include 'COMMON.BANK'
5086 ! include 'COMMON.CHAIN'
5088 real(kind=8),dimension(6*nres) :: xin,xout,xin2 !(maxvar) (maxvar=6*maxres)
5089 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
5090 real(kind=8),dimension(2) :: cout
5091 integer,dimension(9) :: ind
5092 integer,dimension(nres) :: iff !(maxres)
5093 integer,dimension(12) :: info
5094 integer,dimension(mpi_status_size) :: muster
5095 ! include 'COMMON.SETUP'
5096 real(kind=8),parameter :: rad=1.745329252d-2
5097 integer :: n,mm,it,ierr
5099 if (isend2(n).eq.0) then
5100 ! pull out external and internal variables for next start
5101 call putx(xin,n,rad)
5109 if (movenx(n).eq.14.or.movenx(n).eq.17) then
5112 else if (movenx(n).eq.16) then
5126 if (movenx(n).eq.15) then
5131 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,&
5133 call mpi_send(xin,nvar,mpi_double_precision,mm,&
5134 idreal,CG_COMM,ierr)
5136 ! distfit & minimization for n7 move
5146 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,&
5148 call putx2(xin,iff,isend2(n))
5149 call mpi_send(xin,nvar,mpi_double_precision,mm,&
5150 idreal,CG_COMM,ierr)
5151 call mpi_send(iff,nres,mpi_integer,mm,&
5153 call putx(xin2,n,rad)
5154 call mpi_send(xin2,nvar,mpi_double_precision,mm,&
5155 idreal,CG_COMM,ierr)
5157 if (vdisulf.and.nss_in(n).ne.0) then
5158 call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,&
5160 call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,&
5165 !-----------------------------------------------------------------------------
5166 subroutine recv(ihalt,man,xout,eout,ind,tout)
5170 use geometry_data, only: nvar
5171 use control_data, only: vdisulf
5172 ! receives results of energy minimization
5173 ! implicit real*8 (a-h,o-z)
5174 ! include 'DIMENSIONS'
5175 ! include 'COMMON.VAR'
5176 ! include 'COMMON.IOUNITS'
5177 ! include 'COMMON.CONTROL'
5178 ! include 'COMMON.SBRIDGE'
5179 ! include 'COMMON.BANK'
5180 ! include 'COMMON.CHAIN'
5182 real(kind=8),dimension(6*nres) :: xin,xout !(maxvar) (maxvar=6*maxres)
5183 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
5184 real(kind=8),dimension(2) :: cout
5185 integer,dimension(9) :: ind
5186 integer,dimension(12) :: info
5187 integer,dimension(mpi_status_size) :: muster
5188 ! include 'COMMON.SETUP'
5189 logical :: tout,flag
5190 real(kind=8) :: tstart,tend1
5191 real(kind=8),parameter :: twait=600.0d0
5192 integer :: ihalt,man,ierr
5194 ! find an available soldier
5198 do while(.not. (flag .or. tout))
5199 call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag, &
5202 if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
5203 !_error if(tend1-tstart.gt.twait) tout=.true.
5206 write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
5210 man=muster(mpi_source)
5212 !timeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
5213 !timeout * CG_COMM,muster,ierr)
5214 ! print *, ' receiving output from start # ',ind(1)
5215 !t print *,'receiving ',MPI_WTIME()
5216 !timeout man=muster(mpi_source)
5217 call mpi_recv(ind,9,mpi_integer,man,idint,&
5218 CG_COMM,muster,ierr)
5220 ! receive final energies and variables
5221 call mpi_recv(eout,1,mpi_double_precision,&
5222 man,idreal,CG_COMM,muster,ierr)
5225 call mpi_recv(co,1,mpi_double_precision,&
5226 man,idreal,CG_COMM,muster,ierr)
5227 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
5229 call mpi_recv(xout,nvar,mpi_double_precision,&
5230 man,idreal,CG_COMM,muster,ierr)
5231 ! print *,nvar , ierr
5232 if(vdisulf) nss=ind(6)
5233 if(vdisulf.and.nss.ne.0) then
5234 call mpi_recv(ihpb,nss,mpi_integer,&
5235 man,idint,CG_COMM,muster,ierr)
5236 call mpi_recv(jhpb,nss,mpi_integer,&
5237 man,idint,CG_COMM,muster,ierr)
5241 ! print *,'sending halt to ',man
5242 write(iout,*) 'sending halt to ',man
5244 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
5248 !-----------------------------------------------------------------------------
5249 subroutine history_append
5251 ! implicit real*8 (a-h,o-z)
5252 ! include 'DIMENSIONS'
5253 ! include 'COMMON.IOUNITS'
5255 #if defined(AIX) || defined(PGI)
5256 open(icsa_history,file=csa_history,position="append")
5258 open(icsa_history,file=csa_history,access="append")
5261 end subroutine history_append
5262 !-----------------------------------------------------------------------------
5263 subroutine alloc_CSA_arrays
5265 use energy_data, only: ns
5269 if(.not.allocated(bfrag)) allocate(bfrag(4,nres/3))
5272 !el allocate(dihang_in(mxang,nres,mxch,mxio)) !(mxang,maxres,mxch,mxio)
5273 allocate(dihang_in(mxang,nres,mxch,5000)) !(mxang,maxres,mxch,mxio)
5274 allocate(nss_in(mxio)) !(mxio)
5275 allocate(iss_in(ns,mxio),jss_in(ns,mxio)) !(maxss,mxio)
5277 allocate(dihang(mxang,nres,mxch,mxio)) !(mxang,maxres,mxch,mxio)
5278 allocate(rmsn(mxio),pncn(mxio)) !(mxio)
5279 allocate(etot(mxio)) !(mxio)
5280 allocate(nss_out(mxio)) !(mxio)
5281 allocate(iss_out(ns,mxio),jss_out(ns,mxio)) !(maxss,mxio)
5283 allocate(rvar(mxang,nres,mxch,mxio),bvar(mxang,nres,mxch,mxio)) !(mxang,maxres,mxch,mxio)
5284 allocate(bene(mxio),rene(mxio),brmsn(mxio),rrmsn(mxio))
5285 allocate(bpncn(mxio),rpncn(mxio)) !(mxio)
5286 allocate(ibank(mxio),is(mxio),jbank(mxio)) !(mxio)
5287 allocate(dij(mxio,mxio)) !(mxio,mxio)
5288 ! common/bank_disulfid/
5289 allocate(bvar_nss(mxio),bvar_ns(mxio)) !(mxio)
5290 allocate(bvar_s(ns,mxio)) !(maxss,mxio)
5291 allocate(bvar_ss(2,ns,mxio)) !(2,maxss,mxio)
5293 allocate(movenx(mxio),movernx(mxio)) !(mxio)
5294 allocate(nstatnx(0:mxmv,3),nstatnx_tot(0:mxmv,3)) !(0:mxmv,3)
5295 allocate(indb(mxio,9)) !(mxio,9)
5296 allocate(parent(3,mxio)) !(3,mxio)
5298 allocate(isend2(mxio)) !(mxio)
5299 allocate(iff_in(nres,mxio2)) !(maxres,mxio2)
5300 allocate(dihang_in2(mxang,nres,mxch,mxio2)) !(mxang,maxres,mxch,mxio2)
5301 allocate(idata(5,mxio)) !(5,mxio)
5304 allocate(ngroup(mxgr)) !(mxgr)
5305 allocate(igroup(3,mxang,mxgr)) !(3,mxang,mxgr)
5308 allocate(bvar_frag(mxio,6)) !(mxio,6)
5309 allocate(hvar_frag(mxio,3),lvar_frag(mxio,3),svar_frag(mxio,3)) !(mxio,3)
5310 allocate(avar_frag(mxio,5)) !(mxio,5)
5313 allocate(nharp_seed(nseed),nharp_use(nseed)) !(max_seed)
5314 allocate(iharp_seed(4,nres/3,nseed)) !(4,maxres/3,max_seed)
5315 allocate(iharp_use(0:4,nres/3,nseed)) !(0:4,maxres/3,max_seed)
5318 end subroutine alloc_CSA_arrays
5319 !-----------------------------------------------------------------------------
5320 !-----------------------------------------------------------------------------