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,&
210 a5,f3.0,1x,a1,i4,0pf8.1,0pf8.1)') &
211 indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',&
212 indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),&
213 ' rms ',rmsn(n),' %NC ',pncn(n)*100,&
214 chacc,iaccn,difmin,denep
218 ! end of loop over all newly obtained conformations
220 if(nstatnx(i,1).ne.0) then
222 write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
223 '## N',i,' total=',nstatnx(i,1),&
224 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
225 ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
227 write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
228 '##N',i,' total=',nstatnx(i,1),&
229 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
230 ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
234 write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
235 '## N',i,' total=',nstatnx(i,1),&
236 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
239 write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') &
240 '##N',i,' total=',nstatnx(i,1),&
241 ' close=',nstatnx(i,2),' far=',nstatnx(i,3),&
248 !rc moved up, saves some get_diff12 calls
252 !rc if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
253 !rc call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
265 end subroutine refresh_bank
266 !-----------------------------------------------------------------------------
267 subroutine replace_bvar(iold,inew)
269 use control_data, only: vdisulf
270 use energy_data, only: ns,iss
271 ! implicit real*8 (a-h,o-z)
272 ! include 'DIMENSIONS'
274 ! include 'COMMON.IOUNITS'
275 ! include 'COMMON.CSA'
276 ! include 'COMMON.BANK'
277 ! include 'COMMON.CHAIN'
278 ! include 'COMMON.CONTROL'
279 ! include 'COMMON.SBRIDGE'
280 integer :: iold,inew,ierror,ierrcode,i,j,k
282 if (iold.gt.mxio .or. iold.lt.1 .or. inew.gt.mxio .or. inew.lt.1) &
284 write (iout,*) 'Dimension ERROR in REPLACE_BVAR: IOLD',iold,&
286 call mpi_abort(mpi_comm_world,ierror,ierrcode)
291 bvar(i,j,k,iold)=dihang(i,j,k,inew)
295 bene(iold)=etot(inew)
296 brmsn(iold)=rmsn(inew)
297 bpncn(iold)=pncn(inew)
299 if(bene(iold).lt.ebmin) then
305 bvar_nss(iold)=nss_out(inew)
306 !d write(iout,*) 'SS BANK',iold,bvar_nss(iold)
307 do i=1,bvar_nss(iold)
308 bvar_ss(1,i,iold)=iss_out(i,inew)
309 bvar_ss(2,i,iold)=jss_out(i,inew)
310 !d write(iout,*) 'SS',bvar_ss(1,i,iold)-nres,
311 !d & bvar_ss(2,i,iold)-nres
314 bvar_ns(iold)=ns-2*bvar_nss(iold)
315 !d write(iout,*) 'CYS #free ', bvar_ns(iold)
319 do while( iss(i).ne.iss_out(j,inew)-nres .and. &
320 iss(i).ne.jss_out(j,inew)-nres .and. &
324 if (j.gt.nss_out(inew)) then
326 bvar_s(k,iold)=iss(i)
329 !d write(iout,*) 'CYS free',(bvar_s(k,iold),k=1,bvar_ns(iold))
333 end subroutine replace_bvar
334 !-----------------------------------------------------------------------------
335 subroutine save_is(ind)
337 ! implicit real*8 (a-h,o-z)
338 ! include 'DIMENSIONS'
340 ! include 'COMMON.IOUNITS'
341 ! include 'COMMON.CSA'
342 ! include 'COMMON.BANK'
343 ! include 'COMMON.CHAIN'
344 integer :: ind,i,j,k,index,ierror,ierrcode
347 ! print *, "nbank,ind,index,is(ind) ",nbank,ind,index,is(ind)
348 if (index.gt.mxio .or. index.lt.1 .or. &
349 is(ind).gt.mxio .or. is(ind).lt.1) then
350 write (iout,*) 'Dimension ERROR in SAVE_IS: INDEX',index,&
351 ' IND',ind,' IS',is(ind)
352 call mpi_abort(mpi_comm_world,ierror,ierrcode)
357 bvar(i,j,k,index)=bvar(i,j,k,is(ind))
361 bene(index)=bene(is(ind))
365 end subroutine save_is
366 !-----------------------------------------------------------------------------
367 subroutine select_is(n,ifar,idum)
369 ! implicit real*8 (a-h,o-z)
370 ! include 'DIMENSIONS'
371 ! include 'COMMON.CSA'
372 ! include 'COMMON.BANK'
373 integer,dimension(mxio) :: itag
374 real(kind=8),dimension(mxio) :: adiff
375 integer :: n,ifar,idum,i,iusesv,imade
379 if(ibank(i).eq.0) then
389 if(ibank(i).eq.2) then
396 call get_is(idum,ifar,n,imade,0)
397 !test3 call get_is_max(idum,ifar,n,imade,0)
398 else if(iuse.eq.n) then
403 else if(iuse.lt.n) then
404 ! if(icycle.eq.0) then
406 ! ind=mod(i-1,iuse)+1
417 ! call get_is_ran(idum,n,imade,1)
418 call get_is(idum,ifar,n,imade,1)
419 !test3 call get_is_max(idum,ifar,n,imade,1)
420 ! if(iusesv.le.n/10) then
424 ! if(ibank(i).eq.2) then
426 if(ibank(i).ge.2) then
435 call get_is(idum,ifar,n,imade,0)
436 !test3 call get_is_max(idum,ifar,n,imade,0)
441 end subroutine select_is
442 !-----------------------------------------------------------------------------
443 subroutine get_is_ran(idum,n,imade,k)
445 ! implicit real*8 (a-h,o-z)
446 ! include 'DIMENSIONS'
447 ! include 'COMMON.CSA'
448 ! include 'COMMON.BANK'
449 ! real(kind=4) :: ran1,ran2
450 integer,dimension(mxio) :: itag
451 real(kind=8),dimension(mxio) :: adiff
452 integer :: idum,n,imade,k,j,i,iran
457 if(ibank(i).eq.k) then
462 iran=iuse* ran1(idum)+1
468 end subroutine get_is_ran
469 !-----------------------------------------------------------------------------
470 subroutine get_is(idum,ifar,n,imade,k)
472 ! implicit real*8 (a-h,o-z)
473 ! include 'DIMENSIONS'
474 ! include 'COMMON.CSA'
475 ! include 'COMMON.BANK'
476 ! real(kind=4) :: ran1,ran2
477 integer,dimension(mxio) :: itag
478 real(kind=8),dimension(mxio) :: adiff
479 integer :: idum,ifar,n,imade,k,i,iran
483 if(ibank(i).eq.k) then
488 iran=iuse* ran1(idum)+1
494 if(icycle.eq.-1) then
495 call select_iseed_max(i,k)
497 call select_iseed_min(i,k)
498 !test4 call select_iseed_max(i,k)
504 call select_iseed_far(i,k)
509 end subroutine get_is
510 !-----------------------------------------------------------------------------
511 subroutine select_iseed_max(imade1,ik)
513 ! implicit real*8 (a-h,o-z)
514 ! include 'DIMENSIONS'
515 ! include 'COMMON.CSA'
516 ! include 'COMMON.BANK'
517 integer,dimension(mxio) :: itag
518 real(kind=8),dimension(mxio) :: adiff
519 integer :: imade1,ik,i,n,imade,m,itagi
520 real(kind=8) :: difmax,diff,emax,benei,diffmn
526 if(ibank(n).eq.ik) then
531 ! call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
534 if(diff.lt.diffmn) diffmn=diff
536 if(diffmn.gt.difmax) difmax=diffmn
544 ! avedif=(avedif+difmax)/2
547 if(adiff(i).ge.avedif) then
550 if(benei.gt.emax) then
557 if(ik.eq.0) iuse=iuse-1
560 end subroutine select_iseed_max
561 !-----------------------------------------------------------------------------
562 subroutine select_iseed_min(imade1,ik)
564 ! implicit real*8 (a-h,o-z)
565 ! include 'DIMENSIONS'
566 ! include 'COMMON.CSA'
567 ! include 'COMMON.BANK'
568 integer,dimension(mxio) :: itag
569 real(kind=8),dimension(mxio) :: adiff
570 integer :: imade1,ik,n,imade,m,i,itagi
571 real(kind=8) :: difmax,diff,diffmn,emin,benei
577 if(ibank(n).eq.ik) then
582 ! call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
585 if(diff.lt.diffmn) diffmn=diff
587 if(diffmn.gt.difmax) difmax=diffmn
595 ! avedif=(avedif+difmax)/2
598 ! print *,"i, adiff(i),avedif : ",i,adiff(i),avedif
599 if(adiff(i).ge.avedif) then
602 ! print *,"i, benei,emin : ",i,benei,emin
603 if(benei.lt.emin) then
610 if(ik.eq.0) iuse=iuse-1
612 ! print *, "exiting select_iseed_min",is(imade1)
615 end subroutine select_iseed_min
616 !-----------------------------------------------------------------------------
617 subroutine select_iseed_far(imade1,ik)
619 ! implicit real*8 (a-h,o-z)
620 ! include 'DIMENSIONS'
621 ! include 'COMMON.CSA'
622 ! include 'COMMON.BANK'
623 integer :: imade1,ik,n,imade,m
624 real(kind=8) :: dmax,diffmn,diff
628 if(ibank(n).eq.ik) then
632 ! call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
635 if(diff.lt.diffmn) diffmn=diff
638 if(diffmn.gt.dmax) then
645 end subroutine select_iseed_far
646 !-----------------------------------------------------------------------------
649 ! implicit real*8 (a-h,o-z)
650 ! include 'DIMENSIONS'
651 ! include 'COMMON.CSA'
652 ! include 'COMMON.BANK'
654 real(kind=8) :: benei
660 if(benei.lt.ebmin) then
667 end subroutine find_min
668 !-----------------------------------------------------------------------------
671 ! implicit real*8 (a-h,o-z)
672 ! include 'DIMENSIONS'
673 ! include 'COMMON.CSA'
674 ! include 'COMMON.BANK'
676 real(kind=8) :: benei
682 if(benei.gt.ebmax) then
689 end subroutine find_max
690 !-----------------------------------------------------------------------------
693 ! implicit real*8 (a-h,o-z)
694 ! include 'DIMENSIONS'
695 ! include 'COMMON.CSA'
696 ! include 'COMMON.BANK'
698 real(kind=8) :: tdiff,difmin,diff
704 if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
705 call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
712 if(diff.lt.difmin) difmin=diff
721 avedif=tdiff/nbank/(nbank-1)*2
724 end subroutine get_diff
725 !-----------------------------------------------------------------------------
726 subroutine estimate_cutdif(adif,xct,cutdifr)
728 ! implicit real*8 (a-h,o-z)
729 ! include 'DIMENSIONS'
730 ! include 'COMMON.CSA'
731 ! include 'COMMON.BANK'
733 real(kind=8) :: adif,xct,cutdifr,ctdif1,exponent
737 exponent = cutdifr*cut1/adif
738 exponent = dlog(exponent)/dlog(xct)
741 cutdif= adif/cut1*xct**nexp
742 if(cutdif.lt.ctdif1) cutdif=ctdif1
745 end subroutine estimate_cutdif
746 !-----------------------------------------------------------------------------
747 subroutine get_is_max(idum,ifar,n,imade,k)
749 ! implicit real*8 (a-h,o-z)
750 ! include 'DIMENSIONS'
751 ! include 'COMMON.CSA'
752 ! include 'COMMON.BANK'
753 integer :: idum,ifar,n,imade,k,i,j
759 if(ibank(j).eq.k .and. bene(j).gt.emax) then
768 end subroutine get_is_max
769 !-----------------------------------------------------------------------------
771 !-----------------------------------------------------------------------------
772 subroutine make_array
774 use energy_data, only: itype
775 ! implicit real*8 (a-h,o-z)
776 ! include 'DIMENSIONS'
777 ! include 'COMMON.IOUNITS'
778 ! include 'COMMON.CHAIN'
779 ! include 'COMMON.INTERACT'
780 ! include 'COMMON.CSA'
781 integer :: k,j,i,indg
782 !cccccccccccccccccccccccc
784 !cccccccccccccccccccccccc
788 !cccccccccccccccccccccccccccccccccccccccc
789 ! Groups the THETAs and the GAMMAs
792 if (j.lt.nres-1) then
803 !cccccccccccccccccccccccccccccccccccccccc
805 ! Groups the ALPHAs and the BETAs
808 if(itype(j).ne.10) then
822 write(iout,*) "# of groups: ",ntotgr
824 write(iout,41) i,ngroup(i),((igroup(k,j,i),k=1,3),j=1,ngroup(i))
829 41 format(2i3,3x,6(3i3,2x))
832 end subroutine make_array
833 !-----------------------------------------------------------------------------
834 subroutine make_ranvar(n,m,idum)
837 ! implicit real*8 (a-h,o-z)
838 ! include 'DIMENSIONS'
839 ! include 'COMMON.IOUNITS'
840 ! include 'COMMON.CHAIN'
841 ! include 'COMMON.VAR'
842 ! include 'COMMON.BANK'
843 integer :: n,m,j,idum,itrial,jeden
846 print *,'HOHOHOHO Make_RanVar!!!!!',n,m
848 do while(m.lt.n .and. itrial.le.10000)
851 call gen_rand_conf(jeden,*10)
855 dihang_in(1,j,1,m)=theta(j+1)
856 dihang_in(2,j,1,m)=phi(j+2)
857 dihang_in(3,j,1,m)=alph(j)
858 dihang_in(4,j,1,m)=omeg(j)
860 dihang_in(2,nres-1,1,m)=0.0d0
862 10 write (iout,*) 'Failed to generate conformation #',m+1,&
866 print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
869 end subroutine make_ranvar
870 !-----------------------------------------------------------------------------
871 subroutine make_ranvar_reg(n,idum)
874 ! implicit real*8 (a-h,o-z)
875 ! include 'DIMENSIONS'
876 ! include 'COMMON.IOUNITS'
877 ! include 'COMMON.CHAIN'
878 ! include 'COMMON.VAR'
879 ! include 'COMMON.BANK'
880 ! include 'COMMON.GEO'
881 integer :: n,idum,j,m,itrial,jeden
884 print *,'HOHOHOHO Make_RanVar!!!!!'
886 do while(m.lt.n .and. itrial.le.10000)
889 call gen_rand_conf(jeden,*10)
893 dihang_in(1,j,1,m)=theta(j+1)
894 dihang_in(2,j,1,m)=phi(j+2)
895 dihang_in(3,j,1,m)=alph(j)
896 dihang_in(4,j,1,m)=omeg(j)
898 dihang_in(1,j,1,m)=90.0*deg2rad
899 dihang_in(2,j,1,m)=50.0*deg2rad
902 dihang_in(2,nres-1,1,m)=0.0d0
904 10 write (iout,*) 'Failed to generate conformation #',m+1,&
908 print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial
911 end subroutine make_ranvar_reg
912 !-----------------------------------------------------------------------------
914 !-----------------------------------------------------------------------------
915 subroutine get_diff12(aarray,barray,diff)
917 ! implicit real*8 (a-h,o-z)
918 ! include 'DIMENSIONS'
919 ! include 'COMMON.CSA'
920 ! include 'COMMON.BANK'
921 ! include 'COMMON.CHAIN'
922 ! include 'COMMON.GEO'
924 real(kind=8),dimension(mxang,nres,mxch) :: aarray,barray !(mxang,maxres,mxch)
925 real(kind=8) :: diff,dif
933 dif=rad2deg*dabs(aarray(i,j,k)-barray(i,j,k))
934 if(dif.gt.180.) dif=360.-dif
935 if (dif.gt.diffcut) diff=diff+dif
941 end subroutine get_diff12
942 !-----------------------------------------------------------------------------
944 !-----------------------------------------------------------------------------
945 subroutine indexx(n,arr,indx)
947 ! implicit real*8 (a-h,o-z)
949 REAL(kind=8) :: arr(n)
950 ! PARAMETER (M=7,NSTACK=50)
951 integer,PARAMETER :: M=7,NSTACK=500
952 INTEGER :: i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK)
966 if(arr(indx(i)).le.a)goto 2
972 if(jstack.eq.0)return
981 if(arr(indx(l+1)).gt.arr(indx(ir)))then
986 if(arr(indx(l)).gt.arr(indx(ir)))then
991 if(arr(indx(l+1)).gt.arr(indx(l)))then
1002 if(arr(indx(i)).lt.a)goto 3
1005 if(arr(indx(j)).gt.a)goto 4
1014 if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx'
1015 if(ir-i+1.ge.j-l)then
1026 end subroutine indexx
1027 ! (C) Copr. 1986-92 Numerical Recipes Software *11915aZ%.
1028 !-----------------------------------------------------------------------------
1030 !-----------------------------------------------------------------------------
1031 subroutine minim_jlee
1038 use geometry_data, only: nvar,nphi
1039 use geometry, only:dist
1040 use energy, only:fdum
1041 use control, only:init_int_table
1042 use minimm, only:sumsl,deflt
1043 ! controls minimization and sorting routines
1044 ! implicit real*8 (a-h,o-z)
1045 ! include 'DIMENSIONS'
1046 ! include 'COMMON.VAR'
1047 ! include 'COMMON.IOUNITS'
1048 ! include 'COMMON.MINIM'
1049 ! include 'COMMON.CONTROL'
1051 integer,parameter :: liv=60
1053 ! external func,gradient!,fdum !use minim & energy
1054 ! real(kind=4) :: ran1,ran2,ran3
1055 ! include 'COMMON.SETUP'
1056 ! include 'COMMON.GEO'
1057 ! include 'COMMON.FFIELD'
1058 ! include 'COMMON.SBRIDGE'
1059 ! include 'COMMON.DISTFIT'
1060 ! include 'COMMON.CHAIN'
1061 integer,dimension(mpi_status_size) :: muster
1062 real(kind=8),dimension(6*nres) :: var !(maxvar) (maxvar=6*maxres)
1063 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: erg
1064 real(kind=8),dimension(6*nres) :: var2 !(maxvar) (maxvar=6*maxres)
1065 integer,dimension(nres) :: iffr !(maxres)
1066 integer,dimension((nres-1)*(nres-2)/2) :: ihpbt,jhpbt !(maxdim) (maxdim=(maxres-1)*(maxres-2)/2)
1067 real(kind=8),dimension(6*nres) :: d,garbage !(maxvar) (maxvar=6*maxres)
1068 !el real(kind=8),dimension(1:lv+1) :: v
1069 real(kind=8) :: energia(0:n_ene),time0s,time1s
1070 integer,dimension(9) :: indx
1071 integer,dimension(12) :: info
1072 integer,dimension(liv) :: iv
1074 real(kind=8) :: rdum(1)
1075 integer,dimension(2,12*nres) :: icont_ !(2,maxcont)(maxcont=12*maxres)
1076 logical :: fail !check_var,
1078 !el common /przechowalnia/ v
1079 integer :: i,j,ierr,n,nfun,nft_sc,nf,ierror,ierrcode
1080 real(kind=8) :: rad,eee,etot !,fdum
1081 !el from subroutine parmread
1082 ! Define the constants of the disulfide bridge
1083 ! Old arbitrary potential
1084 real(kind=8),parameter :: dbr=4.20D0
1085 real(kind=8),parameter :: fbr=3.30D0
1087 lv=77+(6*nres)*(6*nres+17)/2 !77+maxvar*(maxvar+17)/2 (maxvar=6*maxres)
1088 data rad /1.745329252d-2/
1089 ! receive # of start
1090 ! print *,'Processor',me,' calling MINIM_JLEE maxfun',maxfun,
1091 ! & ' maxmin',maxmin,' tolf',tolf,' rtolf',rtolf
1092 if (.not. allocated(v)) allocate(v(1:lv))
1096 ! print *, 'MINIM_JLEE: ',me,' is waiting'
1097 call mpi_recv(info,12,mpi_integer,king,idint,CG_COMM,&
1100 write (iout,'(a12,f10.4,a4)')'Waiting for ',time1s-time0s,' sec'
1103 ! print *, 'MINIM_JLEE: ',me,' received: ',n
1105 !rc if (ierr.ne.0) go to 100
1108 write (iout,*) 'Finishing minim_jlee - signal',n,' from master'
1115 call mpi_recv(var,nvar,mpi_double_precision,&
1116 king,idreal,CG_COMM,muster,ierr)
1117 call mpi_recv(iffr,nres,mpi_integer,&
1118 king,idint,CG_COMM,muster,ierr)
1119 call mpi_recv(var2,nvar,mpi_double_precision,&
1120 king,idreal,CG_COMM,muster,ierr)
1122 ! receive initial values of variables
1123 call mpi_recv(var,nvar,mpi_double_precision,&
1124 king,idreal,CG_COMM,muster,ierr)
1125 !rc if (ierr.ne.0) go to 100
1128 if(vdisulf.and.info(2).ne.-1) then
1129 if(info(4).ne.0)then
1130 call mpi_recv(ihpbt,info(4),mpi_integer,&
1131 king,idint,CG_COMM,muster,ierr)
1132 call mpi_recv(jhpbt,info(4),mpi_integer,&
1133 king,idint,CG_COMM,muster,ierr)
1143 call contact_cp(var,var2,iffr,nfun,n)
1146 if(vdisulf.and.info(2).ne.-1) then
1148 if(info(4).ne.0)then
1149 !d write(iout,*) 'SS=',info(4),'N=',info(1),'IT=',info(2)
1150 call var_to_geom(nvar,var)
1153 if (dist(ihpbt(i),jhpbt(i)).lt.7.0) then
1157 !d write(iout,*) 'SS mv=',info(3),
1158 !d & ihpb(nss)-nres,jhpb(nss)-nres,
1159 !d & dist(ihpb(nss),jhpb(nss))
1163 !d write(iout,*) 'rm SS mv=',info(3),
1164 !d & ihpbt(i)-nres,jhpbt(i)-nres,dist(ihpbt(i),jhpbt(i))
1174 if (info(3).eq.14) then
1175 write(iout,*) 'calling local_move',info(7),info(8)
1176 call local_move_init(.false.)
1177 call var_to_geom(nvar,var)
1178 call local_move(info(7),info(8),20d0,50d0)
1179 call geom_to_var(nvar,var)
1183 if (info(3).eq.16) then
1184 write(iout,*) 'calling beta_slide',info(7),info(8),&
1185 info(10), info(11), info(12)
1186 call var_to_geom(nvar,var)
1187 call beta_slide(info(7),info(8),info(10),info(11),info(12), &
1189 call geom_to_var(nvar,var)
1193 if (info(3).eq.17) then
1194 write(iout,*) 'calling beta_zip',info(7),info(8)
1195 call var_to_geom(nvar,var)
1196 call beta_zip(info(7),info(8),nfun,n)
1197 call geom_to_var(nvar,var)
1205 call var_to_geom(nvar,var)
1207 call etotal(energia)
1209 if (energia(1).eq.1.0d20) then
1211 write (iout,'(a,1pe14.5)')'#OVERLAP evdw=1d20',energia(1)
1212 call overlap_sc(fail)
1214 call geom_to_var(nvar,var)
1215 call etotal(energia)
1217 write (iout,'(a,1pe14.5)')'#OVERLAP evdw after',energia(1)
1227 call var_to_geom(nvar,var)
1228 call sc_move(2,nres-1,1,10d0,nft_sc,etot)
1229 call geom_to_var(nvar,var)
1230 !d write(iout,*) 'sc_move',nft_sc,etot
1233 if (check_var(var,info)) then
1242 ! write (iout,*) 'MINIM_JLEE: Processor',me,' nvar',nvar
1243 ! write (iout,'(8f10.4)') (var(i),i=1,nvar)
1244 ! write (*,*) 'MINIM_JLEE: Processor',me,' received nvar',nvar
1245 ! write (*,'(8f10.4)') (var(i),i=1,nvar)
1251 call deflt(2,iv,liv,lv,v)
1252 ! 12 means fresh start, dont call deflt
1254 ! max num of fun calls
1255 if (maxfun.eq.0) maxfun=500
1257 ! max num of iterations
1258 if (maxmin.eq.0) maxmin=1000
1262 ! selects output unit
1265 ! 1 means to print out result
1268 ! 1 means to print out summary stats
1270 ! 1 means to print initial x and d
1273 ! if(me.eq.3.and.n.eq.255) then
1274 ! print *,' CHUJ: stoi'
1281 ! min val for v(radfac) default is 0.1
1283 ! max val for v(radfac) default is 4.0
1286 ! check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease)
1287 ! the sumsl default is 0.1
1289 ! false conv if (act fnctn decrease) .lt. v(34)
1290 ! the sumsl default is 100*machep
1292 ! absolute convergence
1293 if (tolf.eq.0.0D0) tolf=1.0D-4
1295 ! relative convergence
1296 if (rtolf.eq.0.0D0) rtolf=1.0D-4
1298 ! controls initial step size
1300 ! large vals of d correspond to small components of step
1308 ! write (iout,*) 'Processor',me,' nvar',nvar
1309 ! write (iout,*) 'Variables BEFORE minimization:'
1310 ! write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar)
1312 ! print *, 'MINIM_JLEE: ',me,' before SUMSL '
1314 call func(nvar,var,nf,eee,idum,rdum,fdum)
1316 if(eee.ge.1.0d20) then
1317 ! print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL'
1318 ! print *,' energy before SUMSL =',eee
1319 ! print *,' aborting local minimization'
1325 !t time0s=MPI_WTIME()
1326 call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum)
1327 !t write(iout,*) 'sumsl time=',MPI_WTIME()-time0s,iv(7),v(10)
1328 ! print *, 'MINIM_JLEE: ',me,' after SUMSL '
1330 ! find which conformation was returned from sumsl
1332 ! print *,'Processor',me,' iv(17)',iv(17),' iv(18)',iv(18),' nf',nf,
1333 ! & ' retcode',iv(1),' energy',v(10),' tolf',v(31),' rtolf',v(32)
1334 ! if (iv(1).ne.4 .or. nf.le.1) then
1335 ! write (*,*) 'Processor',me,' something bad in SUMSL',iv(1),nf
1336 ! write (*,*) 'Initial Variables'
1337 ! write (*,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar)
1338 ! write (*,*) 'Variables'
1339 ! write (*,'(8f10.4)') (rad2deg*var(i),i=1,nvar)
1340 ! write (*,*) 'Vector d'
1341 ! write (*,'(8f10.4)') (d(i),i=1,nvar)
1342 ! write (iout,*) 'Processor',me,' something bad in SUMSL',
1344 ! write (iout,*) 'Initial Variables'
1345 ! write (iout,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar)
1346 ! write (iout,*) 'Variables'
1347 ! write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar)
1348 ! write (iout,*) 'Vector d'
1349 ! write (iout,'(8f10.4)') (d(i),i=1,nvar)
1351 ! if (nf.lt.iv(6)-1) then
1352 ! recalculate intra- and interchain energies
1353 ! call func(nvar,var,nf,v(10),iv,v,fdum)
1354 ! else if (nf.eq.iv(6)-1) then
1355 ! regenerate conformation
1356 ! call var_to_geom(nvar,var)
1359 ! change origin and axes to standard ECEPP format
1360 ! call var_to_geom(nvar,var)
1361 ! write (iout,*) 'MINIM_JLEE after minim: Processor',me,' nvar',nvar
1362 ! write (iout,'(8f10.4)') (var(i),i=1,nvar)
1363 ! write (iout,*) 'Energy:',v(10)
1365 ! print *, 'MINIM_JLEE: ',me,' minimized: ',n
1368 ! return code: 6-gradient 9-number of ftn evaluation, etc
1370 ! total # of ftn evaluations (for iwf=0, it includes all minimizations).
1378 call mpi_send(indx,9,mpi_integer,king,idint,CG_COMM,&
1380 ! send back energies
1382 ! calculate contact order
1384 call contact(.false.,ncont,icont_,co)
1385 erg(1)=v(10)-1.0d2*co
1390 call mpi_send(erg,j,mpi_double_precision,king,idreal,&
1393 call mpi_send(co,j,mpi_double_precision,king,idreal,&
1396 ! send back values of variables
1397 call mpi_send(var,nvar,mpi_double_precision,&
1398 king,idreal,CG_COMM,ierr)
1399 ! print * , 'MINIM_JLEE: Processor',me,' send erg and var '
1401 if(vdisulf.and.info(2).ne.-1.and.nss.ne.0) then
1404 !d call etotal(energia(0))
1406 !d call enerprint(energia(0))
1407 call mpi_send(ihpb,nss,mpi_integer,&
1408 king,idint,CG_COMM,ierr)
1409 call mpi_send(jhpb,nss,mpi_integer,&
1410 king,idint,CG_COMM,ierr)
1414 100 print *, ' error in receiving message from emperor', me
1415 call mpi_abort(mpi_comm_world,ierror,ierrcode)
1417 200 print *, ' error in sending message to emperor'
1418 call mpi_abort(mpi_comm_world,ierror,ierrcode)
1420 300 print *, ' error in communicating with emperor'
1421 call mpi_abort(mpi_comm_world,ierror,ierrcode)
1423 956 format (' initial energy could not be calculated',41x)
1425 965 format (' convergence code ',i2,' # of function calls ',&
1426 i4,' # of gradient calls ',i4,10x)
1427 975 format (' energy ',1p,e12.4,' scaled gradient ',e11.3,32x)
1428 end subroutine minim_jlee
1429 !-----------------------------------------------------------------------------
1431 !-----------------------------------------------------------------------------
1432 subroutine make_var(n,idum,iter_csa)
1437 use control_data, only: vdisulf
1439 use geometry, only: dist
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).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).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).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).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
4349 !cccccccccccccccccccccccccccccccccccccc
4350 do while (.not. finished)
4351 !cccccccccccccccccccccccccccccccccccccc
4352 !rc print *,"iter ", iter,' isent=',isent
4354 IF (ME.EQ.KING) THEN
4355 ! start energy minimization
4357 if (isent.eq.0) then
4358 ! king-emperor - select seeds & make var & feed input
4359 !d print *,'generating new conf',ntrial,MPI_WTIME()
4360 call select_is(nseed,ifar,idum)
4362 open(icsa_seed,file=csa_seed,status="old")
4363 write(icsa_seed,39) &
4364 jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
4367 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
4368 ebmin,ebmax,nft,iuse,nbank,ntbank
4373 call make_var(ntry,idum,iter)
4374 !d print *,'new trial generated',ntrial,MPI_WTIME()
4376 write (iout,'(a20,i4,f12.2)') &
4377 'Time for make trial',iter+1,time2i-time1i
4380 !rc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
4381 !rc call feedin(ntry,nft)
4384 if (isent.ge.nodes.or.iter.gt.0) then
4385 !t print *,'waiting ',MPI_WTIME()
4387 call recv(0,ifrom,xout,eout,ind,timeout)
4388 !t print *,' ',irecv,' received from',ifrom,MPI_WTIME()
4393 !t print *,'sending to',ifrom,MPI_WTIME()
4394 call send(isent,ifrom,iter)
4395 !t print *,isent,' sent ',MPI_WTIME()
4397 ! store results -----------------------------------------------
4398 if (isent.ge.nodes.or.iter.gt.0) then
4400 movernx(irecv)=iabs(ind(5))
4401 call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
4405 iss_out(i,irecv)=ihpb(i)
4406 jss_out(i,irecv)=jhpb(i)
4410 call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
4412 !--------------------------------------------------------------
4413 if (isent.eq.ntry) then
4415 write (iout,'(a18,f12.2,a14,f10.2)') &
4416 'Nonsetup time ',time1i-time_start_c,&
4417 ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
4418 write (iout,'(a14,i4,f12.2,a14,f10.2)') &
4419 'Time for iter ',iter+1,time1i-time0i,&
4420 ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
4423 cutdif=cutdif*xctdif
4424 if(cutdif.lt.ctdif1) cutdif=ctdif1
4426 print *,'UPDATING ',ntry-nodes+1,irecv
4427 write(iout,*) 'UPDATING ',ntry-nodes+1
4429 !----------------- call update(ntry-nodes+1) -------------------
4430 nstep=nstep+ntry-nseed-(nodes-1)
4431 call refresh_bank(ntry-nodes+1)
4432 !!bankt call refresh_bankt(ntry-nodes+1)
4434 !----------------- call update(ntry) ---------------------------
4436 print *,'UPDATING ',ntry,irecv
4437 write(iout,*) 'UPDATING ',ntry
4438 nstep=nstep+ntry-nseed
4439 call refresh_bank(ntry)
4440 !!bankt call refresh_bankt(ntry)
4442 !-----------------------------------------------------------------
4444 call write_bank(jlee,nft)
4445 !!bankt call write_bankt(jlee,nft)
4449 write (iout,'(a20,i4,f12.2)') &
4450 'Time for refresh ',iter,time1i-time0i
4452 if(ebmin.lt.estop) finished=.true.
4453 if(icycle.gt.icmax) then
4454 call write_bank1(jlee)
4460 if(nbank.gt.1000) then
4467 if(nstep.gt.nstmax) finished=.true.
4469 if(finished.or.sync_iter) then
4471 call recv(1,ifrom,xout,eout,ind,timeout)
4474 print *,'ERROR worker is not responding'
4475 write(iout,*) 'ERROR worker is not responding'
4476 time1i=MPI_WTIME()-time_start_c
4477 print *,'End of cycle, master time for ',iter,' iters ',&
4478 time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
4479 write (iout,*) 'End of cycle, master time for ',iter,&
4480 ' iters ',time1i,' sec'
4481 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
4482 print *,'UPDATING ',ij-1
4483 write(iout,*) 'UPDATING ',ij-1
4485 call refresh_bank(ij-1)
4486 !!bankt call refresh_bankt(ij-1)
4489 ! print *,'node ',ifrom,' finished ',ij,nft
4490 write(iout,*) 'node ',ifrom,' finished ',ij,nft
4493 movernx(ij)=iabs(ind(5))
4494 call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
4498 iss_out(i,ij)=ihpb(i)
4499 jss_out(i,ij)=jhpb(i)
4503 call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
4506 !rc print *,'---------bcast finished--------',finished
4507 time1i=MPI_WTIME()-time_start_c
4508 print *,'End of cycle, master time for ',iter,' iters ',&
4509 time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
4510 write (iout,*) 'End of cycle, master time for ',iter,&
4511 ' iters ',time1i,' sec'
4512 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
4514 !timeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
4515 !timeout call mpi_bcast(sync_iter,1,mpi_logical,0,
4516 !timeout & CG_COMM,ierr)
4519 call mpi_issend(finished,1,mpi_logical,ij,idchar,&
4521 call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,&
4525 do while(.not. (flag .or. timeout1))
4526 call MPI_TEST(ireq2,flag,muster,ierr)
4528 if(tend1-tstart.gt.60) then
4529 print *,'ERROR worker ',ij,' is not responding'
4530 write(iout,*) 'ERROR worker ',ij,' is not responding'
4535 write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
4538 write(iout,*) 'worker ',ij,' OK ',tend1-tstart
4541 print *,'UPDATING ',nodes-1,ij
4542 write(iout,*) 'UPDATING ',nodes-1
4543 call refresh_bank(nodes-1)
4544 !!bankt call refresh_bankt(nodes-1)
4546 call write_bank(jlee,nft)
4547 !!bankt call write_bankt(jlee,nft)
4552 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
4557 write(iout,*)'### Total stats:'
4559 if(nstatnx_tot(i,1).ne.0) then
4561 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4562 '### N',i,' total=',nstatnx_tot(i,1),&
4563 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',&
4564 (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
4566 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4567 '###N',i,' total=',nstatnx_tot(i,1),&
4568 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',&
4569 (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
4573 write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4574 '### N',i,' total=',nstatnx_tot(i,1),&
4575 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),&
4578 write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') &
4579 '###N',i,' total=',nstatnx_tot(i,1),&
4580 ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),&
4587 if(sync_iter) goto 331
4589 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
4590 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
4592 44 format('jlee =',i3,':',4f10.1,' E =',f8.3,i7,i10)
4598 ! soldier - perform energy minimization
4600 print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
4601 write (iout,*) 'End of minim, proc',me,'time ',&
4602 MPI_WTIME()-time_start
4604 !timeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
4605 !timeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
4606 call mpi_recv(finished,1,mpi_logical,0,idchar,&
4607 CG_COMM,muster,ierr)
4608 call mpi_recv(sync_iter,1,mpi_logical,0,idchar,&
4609 CG_COMM,muster,ierr)
4610 if(sync_iter) goto 331
4613 !cccccccccccccccccccccccccccccccccccccc
4615 !cccccccccccccccccccccccccccccccccccccc
4617 IF (ME.EQ.KING) THEN
4619 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
4620 ebmin,ebmax,nft,iuse,nbank,ntbank
4622 write(icsa_history,44) jlee,0.0,0.0,0.0,&
4624 write(icsa_history,*)
4627 time1i=MPI_WTIME()-time_start
4628 print *,'End of RUN, master time ',&
4629 time1i,'sec, Eval/s ',(nft-nft00)/time1i
4630 write (iout,*) 'End of RUN, master time ',&
4632 write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
4635 write(iout,*) '!!!! ERROR worker was not responding'
4636 write(iout,*) '!!!! cannot finish work normally'
4637 write(iout,*) 'Processor0 is calling MPI_ABORT'
4638 print *,'!!!! ERROR worker was not responding'
4639 print *,'!!!! cannot finish work normally'
4640 print *,'Processor0 is calling MPI_ABORT'
4642 call mpi_abort(mpi_comm_world, 111, ierr)
4646 !ccccccccccccccccccccccccccccc
4648 !ccccccccccccccccccccccccccccc
4651 end subroutine together
4652 !-----------------------------------------------------------------------------
4653 subroutine feedin(nconf,nft)
4656 use geometry_data, only:nvar
4657 use io, only:write_csa_pdb
4658 ! sends out starting conformations and receives results of energy minimization
4659 ! implicit real*8 (a-h,o-z)
4660 ! include 'DIMENSIONS'
4661 ! include 'COMMON.VAR'
4662 ! include 'COMMON.IOUNITS'
4663 ! include 'COMMON.CONTROL'
4665 real(kind=8),dimension(6*nres) :: xin,xout !(maxvar) (maxvar=6*maxres)
4666 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
4667 real(kind=8),dimension(2) :: cout
4668 integer,dimension(9) :: ind
4669 integer,dimension(12) :: info
4670 integer,dimension(mpi_status_size) :: muster
4671 ! include 'COMMON.SETUP'
4672 real(kind=8),parameter :: rad=1.745329252d-2
4673 integer :: j,nconf,nft,mm,n,ierror,ierrcode,ierr,iw_pdb,&
4676 print *,'FEEDIN: NCONF=',nconf
4678 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4679 if (nconf .lt. nodes-1) then
4680 write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',&
4682 write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',&
4684 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4687 ! pull out external and internal variables for next start
4688 call putx(xin,n,rad)
4689 ! write (iout,*) 'XIN from FEEDIN N=',n
4690 ! write(iout,'(8f10.4)') (xin(j),j=1,nvar)
4692 if (mm.lt.nodes) then
4693 ! feed task to soldier
4694 ! print *, ' sending input for start # ',n
4701 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,&
4703 call mpi_send(xin,nvar,mpi_double_precision,mm,&
4704 idreal,CG_COMM,ierr)
4706 ! find an available soldier
4707 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,&
4708 CG_COMM,muster,ierr)
4709 ! print *, ' receiving output from start # ',ind(1)
4710 man=muster(mpi_source)
4711 ! receive final energies and variables
4713 call mpi_recv(eout,1,mpi_double_precision,&
4714 man,idreal,CG_COMM,muster,ierr)
4717 call mpi_recv(co,1,mpi_double_precision,&
4718 man,idreal,CG_COMM,muster,ierr)
4719 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
4721 call mpi_recv(xout,nvar,mpi_double_precision,&
4722 man,idreal,CG_COMM,muster,ierr)
4723 ! print *,nvar , ierr
4724 ! feed next task to soldier
4725 ! print *, ' sending input for start # ',n
4735 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,&
4737 call mpi_send(xin,nvar,mpi_double_precision,man,&
4738 idreal,CG_COMM,ierr)
4739 ! retrieve latest results
4740 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
4742 call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
4745 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4747 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4749 ! wait for a soldier
4750 call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,&
4751 CG_COMM,muster,ierr)
4752 !rc if (ierr.ne.0) go to 30
4753 ! print *, ' receiving output from start # ',ind(1)
4754 man=muster(mpi_source)
4755 ! receive final energies and variables
4757 call mpi_recv(eout,1,&
4758 mpi_double_precision,man,idreal,&
4759 CG_COMM,muster,ierr)
4762 call mpi_recv(co,1,mpi_double_precision,&
4763 man,idreal,CG_COMM,muster,ierr)
4764 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
4766 !rc if (ierr.ne.0) go to 30
4767 call mpi_recv(xout,nvar,mpi_double_precision,&
4768 man,idreal,CG_COMM,muster,ierr)
4769 ! print *,nvar , ierr
4770 !rc if (ierr.ne.0) go to 30
4778 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,&
4781 call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
4783 call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
4785 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4787 10 print *, ' dispatching error'
4788 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4790 20 print *, ' communication error'
4791 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4793 30 print *, ' receiving error'
4794 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4797 end subroutine feedin
4798 !-----------------------------------------------------------------------------
4799 subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
4803 use compare, only: contact_fract
4806 ! receives and stores data from soldiers
4807 ! implicit real*8 (a-h,o-z)
4808 ! include 'DIMENSIONS'
4809 ! include 'COMMON.IOUNITS'
4810 ! include 'COMMON.CSA'
4811 ! include 'COMMON.BANK'
4812 ! include 'COMMON.VAR'
4813 ! include 'COMMON.CHAIN'
4814 ! include 'COMMON.CONTACTS'
4815 integer,dimension(9) :: ind
4816 real(kind=8),dimension(6*nres) :: xout !(maxvar) (maxvar=6*maxres)
4817 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
4819 real(kind=8) :: przes(3),obr(3,3),cout(2)
4821 integer :: iw_pdb,k,j,ierror,ierrcode
4822 real(kind=8) :: rad,co
4825 if (k.gt.mxio .or. k.lt.1) then
4827 'ERROR - dimensions of ANGMIN have been exceeded K=',k
4828 call mpi_abort(mpi_comm_world,ierror,ierrcode)
4836 ! retrieve dihedral angles etc
4837 call var_to_geom(nvar,xout)
4839 dihang(1,j,1,k)=theta(j+1)
4840 dihang(2,j,1,k)=phi(j+2)
4841 dihang(3,j,1,k)=alph(j)
4842 dihang(4,j,1,k)=omeg(j)
4844 dihang(2,nres-1,1,k)=0.0d0
4848 !d write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
4849 !d & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
4854 ! call dihang_to_c(dihang(1,1,1,k))
4855 ! call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
4856 ! call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
4857 ! call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
4858 ! & nsup,przes,obr,non_conv)
4859 ! rmsn(k)=dsqrt(rms)
4861 call rmsd_csa(rmsn(k))
4862 call contact(.false.,ncont,icont,co)
4863 pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
4865 !d write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
4866 !d & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
4867 !d & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
4868 !d & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
4872 if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
4875 !-----------------------------------------------------------------------------
4876 subroutine putx(xin,n,rad)
4879 ! gets starting variables
4880 ! implicit real*8 (a-h,o-z)
4881 ! include 'DIMENSIONS'
4882 ! include 'COMMON.CSA'
4883 ! include 'COMMON.BANK'
4884 ! include 'COMMON.VAR'
4885 ! include 'COMMON.CHAIN'
4886 ! include 'COMMON.IOUNITS'
4888 real(kind=8),dimension(6*nres) :: xin !(maxvar) (maxvar=6*maxres)
4891 ! pull out starting values for variables
4892 ! write (iout,*)'PUTX: N=',n
4894 ! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
4895 ! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
4896 ! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
4897 ! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
4899 theta(j+1)=dihang_in(1,j,m,n)
4900 phi(j+2)=dihang_in(2,j,m,n)
4901 alph(j)=dihang_in(3,j,m,n)
4902 omeg(j)=dihang_in(4,j,m,n)
4905 ! set up array of variables
4906 call geom_to_var(nvar,xin)
4907 ! write (iout,*) 'xin in PUTX N=',n
4909 ! write (iout,'(8f10.4)') (xin(i),i=1,nvar)
4912 !-----------------------------------------------------------------------------
4913 subroutine putx2(xin,iff,n)
4916 ! gets starting variables
4917 ! implicit real*8 (a-h,o-z)
4918 ! include 'DIMENSIONS'
4919 ! include 'COMMON.CSA'
4920 ! include 'COMMON.BANK'
4921 ! include 'COMMON.VAR'
4922 ! include 'COMMON.CHAIN'
4923 ! include 'COMMON.IOUNITS'
4925 real(kind=8),dimension(6*nres) :: xin !(maxvar) (maxvar=6*maxres)
4926 integer,dimension(nres) :: iff !(maxres)
4928 ! pull out starting values for variables
4931 theta(j+1)=dihang_in2(1,j,m,n)
4932 phi(j+2)=dihang_in2(2,j,m,n)
4933 alph(j)=dihang_in2(3,j,m,n)
4934 omeg(j)=dihang_in2(4,j,m,n)
4937 ! set up array of variables
4938 call geom_to_var(nvar,xin)
4944 end subroutine putx2
4945 !-----------------------------------------------------------------------------
4946 subroutine prune_bank(p_cut)
4949 ! implicit real*8 (a-h,o-z)
4950 ! include 'DIMENSIONS'
4952 ! include 'COMMON.CSA'
4953 ! include 'COMMON.BANK'
4954 ! include 'COMMON.IOUNITS'
4955 ! include 'COMMON.CHAIN'
4956 ! include 'COMMON.TIME1'
4957 ! include 'COMMON.SETUP'
4958 integer :: k,j,i,m,ip,nprune
4959 real(kind=8) :: p_cut,diff,ddmin
4960 !---------------------------
4961 ! This subroutine prunes bank conformations using p_cut
4962 !---------------------------
4970 dihang(i,j,k,nprune)=bvar(i,j,k,m)
4974 bene(nprune)=bene(m)
4975 brmsn(nprune)=brmsn(m)
4976 bpncn(nprune)=bpncn(m)
4981 call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
4982 if(diff.lt.p_cut) goto 100
4983 if(diff.lt.ddmin) ddmin=diff
4989 dihang(i,j,k,nprune)=bvar(i,j,k,m)
4993 bene(nprune)=bene(m)
4994 brmsn(nprune)=brmsn(m)
4995 bpncn(nprune)=bpncn(m)
4997 write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
5000 print *, 'Pruning :',m,nprune,p_cut
5001 call write_bank(0,0)
5004 end subroutine prune_bank
5005 !-----------------------------------------------------------------------------
5006 subroutine reminimize(jlee)
5009 ! implicit real*8 (a-h,o-z)
5010 ! include 'DIMENSIONS'
5012 ! include 'COMMON.CSA'
5013 ! include 'COMMON.BANK'
5014 ! include 'COMMON.IOUNITS'
5015 ! include 'COMMON.CHAIN'
5016 ! include 'COMMON.TIME1'
5017 ! include 'COMMON.SETUP'
5018 integer :: i,j,k,jlee,index,nft,ntry
5019 !---------------------------
5020 ! This subroutine re-minimizes bank conformations:
5021 !---------------------------
5028 if (me.eq.king) then
5029 open(icsa_history,file=csa_history,status="old")
5030 write(icsa_history,*) "Re-minimization",nodes,"nodes"
5031 write(icsa_history,851) (bene(i),i=1,nbank)
5032 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
5033 ebmin,ebmax,nft,iuse,nbank,ntbank
5039 dihang_in(i,j,k,index)=bvar(i,j,k,index)
5045 call feedin(ntry,nft)
5053 if (me.eq.king) then
5055 call replace_bvar(i,i)
5057 open(icsa_history,file=csa_history,status="old")
5058 write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,&
5059 ebmin,ebmax,nft,iuse,nbank,ntbank
5060 write(icsa_history,851) (bene(i),i=1,nbank)
5062 call write_bank_reminimized(jlee,nft)
5065 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
5068 ! 850 format(10f8.3)
5071 end subroutine reminimize
5072 !-----------------------------------------------------------------------------
5073 subroutine send(n,mm,it)
5076 use geometry_data, only: nvar
5077 use control_data, only: vdisulf
5078 ! sends out starting conformation for minimization
5079 ! implicit real*8 (a-h,o-z)
5080 ! include 'DIMENSIONS'
5081 ! include 'COMMON.VAR'
5082 ! include 'COMMON.IOUNITS'
5083 ! include 'COMMON.CONTROL'
5084 ! include 'COMMON.BANK'
5085 ! include 'COMMON.CHAIN'
5087 real(kind=8),dimension(6*nres) :: xin,xout,xin2 !(maxvar) (maxvar=6*maxres)
5088 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
5089 real(kind=8),dimension(2) :: cout
5090 integer,dimension(9) :: ind
5091 integer,dimension(nres) :: iff !(maxres)
5092 integer,dimension(12) :: info
5093 integer,dimension(mpi_status_size) :: muster
5094 ! include 'COMMON.SETUP'
5095 real(kind=8),parameter :: rad=1.745329252d-2
5096 integer :: n,mm,it,ierr
5098 if (isend2(n).eq.0) then
5099 ! pull out external and internal variables for next start
5100 call putx(xin,n,rad)
5108 if (movenx(n).eq.14.or.movenx(n).eq.17) then
5111 else if (movenx(n).eq.16) then
5125 if (movenx(n).eq.15) then
5130 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,&
5132 call mpi_send(xin,nvar,mpi_double_precision,mm,&
5133 idreal,CG_COMM,ierr)
5135 ! distfit & minimization for n7 move
5145 call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,&
5147 call putx2(xin,iff,isend2(n))
5148 call mpi_send(xin,nvar,mpi_double_precision,mm,&
5149 idreal,CG_COMM,ierr)
5150 call mpi_send(iff,nres,mpi_integer,mm,&
5152 call putx(xin2,n,rad)
5153 call mpi_send(xin2,nvar,mpi_double_precision,mm,&
5154 idreal,CG_COMM,ierr)
5156 if (vdisulf.and.nss_in(n).ne.0) then
5157 call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,&
5159 call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,&
5164 !-----------------------------------------------------------------------------
5165 subroutine recv(ihalt,man,xout,eout,ind,tout)
5169 use geometry_data, only: nvar
5170 use control_data, only: vdisulf
5171 ! receives results of energy minimization
5172 ! implicit real*8 (a-h,o-z)
5173 ! include 'DIMENSIONS'
5174 ! include 'COMMON.VAR'
5175 ! include 'COMMON.IOUNITS'
5176 ! include 'COMMON.CONTROL'
5177 ! include 'COMMON.SBRIDGE'
5178 ! include 'COMMON.BANK'
5179 ! include 'COMMON.CHAIN'
5181 real(kind=8),dimension(6*nres) :: xin,xout !(maxvar) (maxvar=6*maxres)
5182 real(kind=8),dimension(mxch*(mxch+1)/2+1) :: eout
5183 real(kind=8),dimension(2) :: cout
5184 integer,dimension(9) :: ind
5185 integer,dimension(12) :: info
5186 integer,dimension(mpi_status_size) :: muster
5187 ! include 'COMMON.SETUP'
5188 logical :: tout,flag
5189 real(kind=8) :: tstart,tend1
5190 real(kind=8),parameter :: twait=600.0d0
5191 integer :: ihalt,man,ierr
5193 ! find an available soldier
5197 do while(.not. (flag .or. tout))
5198 call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag, &
5201 if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
5202 !_error if(tend1-tstart.gt.twait) tout=.true.
5205 write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
5209 man=muster(mpi_source)
5211 !timeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
5212 !timeout * CG_COMM,muster,ierr)
5213 ! print *, ' receiving output from start # ',ind(1)
5214 !t print *,'receiving ',MPI_WTIME()
5215 !timeout man=muster(mpi_source)
5216 call mpi_recv(ind,9,mpi_integer,man,idint,&
5217 CG_COMM,muster,ierr)
5219 ! receive final energies and variables
5220 call mpi_recv(eout,1,mpi_double_precision,&
5221 man,idreal,CG_COMM,muster,ierr)
5224 call mpi_recv(co,1,mpi_double_precision,&
5225 man,idreal,CG_COMM,muster,ierr)
5226 write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
5228 call mpi_recv(xout,nvar,mpi_double_precision,&
5229 man,idreal,CG_COMM,muster,ierr)
5230 ! print *,nvar , ierr
5231 if(vdisulf) nss=ind(6)
5232 if(vdisulf.and.nss.ne.0) then
5233 call mpi_recv(ihpb,nss,mpi_integer,&
5234 man,idint,CG_COMM,muster,ierr)
5235 call mpi_recv(jhpb,nss,mpi_integer,&
5236 man,idint,CG_COMM,muster,ierr)
5240 ! print *,'sending halt to ',man
5241 write(iout,*) 'sending halt to ',man
5243 call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
5247 !-----------------------------------------------------------------------------
5248 subroutine history_append
5250 ! implicit real*8 (a-h,o-z)
5251 ! include 'DIMENSIONS'
5252 ! include 'COMMON.IOUNITS'
5254 #if defined(AIX) || defined(PGI)
5255 open(icsa_history,file=csa_history,position="append")
5257 open(icsa_history,file=csa_history,access="append")
5260 end subroutine history_append
5261 !-----------------------------------------------------------------------------
5262 subroutine alloc_CSA_arrays
5264 use energy_data, only: ns
5268 if(.not.allocated(bfrag)) allocate(bfrag(4,nres/3))
5271 !el allocate(dihang_in(mxang,nres,mxch,mxio)) !(mxang,maxres,mxch,mxio)
5272 allocate(dihang_in(mxang,nres,mxch,5000)) !(mxang,maxres,mxch,mxio)
5273 allocate(nss_in(mxio)) !(mxio)
5274 allocate(iss_in(ns,mxio),jss_in(ns,mxio)) !(maxss,mxio)
5276 allocate(dihang(mxang,nres,mxch,mxio)) !(mxang,maxres,mxch,mxio)
5277 allocate(rmsn(mxio),pncn(mxio)) !(mxio)
5278 allocate(etot(mxio)) !(mxio)
5279 allocate(nss_out(mxio)) !(mxio)
5280 allocate(iss_out(ns,mxio),jss_out(ns,mxio)) !(maxss,mxio)
5282 allocate(rvar(mxang,nres,mxch,mxio),bvar(mxang,nres,mxch,mxio)) !(mxang,maxres,mxch,mxio)
5283 allocate(bene(mxio),rene(mxio),brmsn(mxio),rrmsn(mxio))
5284 allocate(bpncn(mxio),rpncn(mxio)) !(mxio)
5285 allocate(ibank(mxio),is(mxio),jbank(mxio)) !(mxio)
5286 allocate(dij(mxio,mxio)) !(mxio,mxio)
5287 ! common/bank_disulfid/
5288 allocate(bvar_nss(mxio),bvar_ns(mxio)) !(mxio)
5289 allocate(bvar_s(ns,mxio)) !(maxss,mxio)
5290 allocate(bvar_ss(2,ns,mxio)) !(2,maxss,mxio)
5292 allocate(movenx(mxio),movernx(mxio)) !(mxio)
5293 allocate(nstatnx(0:mxmv,3),nstatnx_tot(0:mxmv,3)) !(0:mxmv,3)
5294 allocate(indb(mxio,9)) !(mxio,9)
5295 allocate(parent(3,mxio)) !(3,mxio)
5297 allocate(isend2(mxio)) !(mxio)
5298 allocate(iff_in(nres,mxio2)) !(maxres,mxio2)
5299 allocate(dihang_in2(mxang,nres,mxch,mxio2)) !(mxang,maxres,mxch,mxio2)
5300 allocate(idata(5,mxio)) !(5,mxio)
5303 allocate(ngroup(mxgr)) !(mxgr)
5304 allocate(igroup(3,mxang,mxgr)) !(3,mxang,mxgr)
5307 allocate(bvar_frag(mxio,6)) !(mxio,6)
5308 allocate(hvar_frag(mxio,3),lvar_frag(mxio,3),svar_frag(mxio,3)) !(mxio,3)
5309 allocate(avar_frag(mxio,5)) !(mxio,5)
5312 allocate(nharp_seed(nseed),nharp_use(nseed)) !(max_seed)
5313 allocate(iharp_seed(4,nres/3,nseed)) !(4,maxres/3,max_seed)
5314 allocate(iharp_use(0:4,nres/3,nseed)) !(0:4,maxres/3,max_seed)
5317 end subroutine alloc_CSA_arrays
5318 !-----------------------------------------------------------------------------
5319 !-----------------------------------------------------------------------------