+++ /dev/null
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine make_var(n,idum,iter_csa)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.INTERACT'
- include 'COMMON.HAIRPIN'
- include 'COMMON.VAR'
- include 'COMMON.DISTFIT'
- include 'COMMON.GEO'
- include 'COMMON.CONTROL'
- logical nicht_getan,nicht_getan1,fail,lfound
- integer nharp,iharp(4,maxres/3),nconf_harp
- integer iisucc(mxio)
- logical ifused(mxio)
- integer nhx_seed(max_seed),ihx_seed(4,maxres/3,max_seed)
- integer nhx_use(max_seed),ihx_use(0:4,maxres/3,max_seed)
- integer nlx_seed(max_seed),ilx_seed(2,maxres/3,max_seed),
- & nlx_use(max_seed),ilx_use(maxres/3,max_seed)
- real ran1,ran2
-
- write (iout,*) 'make_var : nseed=',nseed,'ntry=',n
- index=0
-
-c-----------------------------------------
- if (n7.gt.0.or.n8.gt.0.or.n9.gt.0.or.n14.gt.0.or.n15.gt.0
- & .or.n16.gt.0.or.n17.gt.0.or.n18.gt.0)
- & call select_frag(n7frag,n8frag,n14frag,
- & n15frag,nbefrag,iter_csa)
-
-c---------------------------------------------------
-c N18 - random perturbation of one phi(=gamma) angle in a loop
-c
- IF (n18.gt.0) THEN
- nlx_tot=0
- do iters=1,nseed
- i1=is(iters)
- nlx_seed(iters)=0
- do i2=1,n14frag
- if (lvar_frag(i2,1).eq.i1) then
- nlx_seed(iters)=nlx_seed(iters)+5
- ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2)
- ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3)
- ilx_use(nlx_seed(iters),iters)=5
- endif
- enddo
- nlx_use(iters)=nlx_seed(iters)
- nlx_tot=nlx_tot+nlx_seed(iters)
- enddo
-
- if (nlx_tot .ge. n18*nseed) then
- ntot_gen=n18*nseed
- else
- ntot_gen=(nlx_tot/nseed)*nseed
- endif
-
- ngen=0
- do while (ngen.lt.ntot_gen)
- do iters=1,nseed
- iseed=is(iters)
- if (nlx_use(iters).gt.0) then
- nicht_getan=.true.
- do while (nicht_getan)
- iih=iran_num(1,nlx_seed(iters))
- if (ilx_use(iih,iters).gt.0) then
- nicht_getan=.false.
- ilx_use(iih,iters)=ilx_use(iih,iters)-1
- nlx_use(iters)=nlx_use(iters)-1
- endif
- enddo
- ngen=ngen+1
- index=index+1
- movenx(index)=18
- parent(1,index)=iseed
- parent(2,index)=0
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- jr=iran_num(ilx_seed(1,iih,iters),ilx_seed(2,iih,iters))
- d=ran_number(-pi,pi)
- dihang_in(2,jr-2,1,index)=pinorm(dihang_in(2,jr-2,1,index)+d)
-
-
- if (ngen.eq.ntot_gen) goto 145
- endif
- enddo
- enddo
- 145 continue
-
- ENDIF
-
-
-c-----------------------------------------
-c N17 : zip a beta in a seed by forcing one additional p-p contact
-c
- IF (n17.gt.0) THEN
- nhx_tot=0
- do iters=1,nseed
- i1=is(iters)
- nhx_seed(iters)=0
- nhx_use(iters)=0
- do i2=1,nbefrag
- if (avar_frag(i2,1).eq.i1) then
- nhx_seed(iters)=nhx_seed(iters)+1
- ihx_use(2,nhx_seed(iters),iters)=1
- if (avar_frag(i2,5)-avar_frag(i2,3).le.3.and.
- & avar_frag(i2,2).gt.1.and.avar_frag(i2,4).lt.nres) then
- ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
- ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1
- ihx_use(0,nhx_seed(iters),iters)=1
- ihx_use(1,nhx_seed(iters),iters)=0
- nhx_use(iters)=nhx_use(iters)+1
- else
- if (avar_frag(i2,4).gt.avar_frag(i2,5)) then
- if (avar_frag(i2,2).gt.1.and.
- & avar_frag(i2,4).lt.nres) then
- ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
- ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1
- ihx_use(0,nhx_seed(iters),iters)=1
- ihx_use(1,nhx_seed(iters),iters)=0
- nhx_use(iters)=nhx_use(iters)+1
- endif
- if (avar_frag(i2,3).lt.nres.and.
- & avar_frag(i2,5).gt.1) then
- ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1
- ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)-1
- ihx_use(0,nhx_seed(iters),iters)=
- & ihx_use(0,nhx_seed(iters),iters)+1
- ihx_use(2,nhx_seed(iters),iters)=0
- nhx_use(iters)=nhx_use(iters)+1
- endif
- else
- if (avar_frag(i2,2).gt.1.and.
- & avar_frag(i2,4).gt.1) then
- ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
- ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)-1
- ihx_use(0,nhx_seed(iters),iters)=1
- ihx_use(1,nhx_seed(iters),iters)=0
- nhx_use(iters)=nhx_use(iters)+1
- endif
- if (avar_frag(i2,3).lt.nres.and.
- & avar_frag(i2,5).lt.nres) then
- ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1
- ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)+1
- ihx_use(0,nhx_seed(iters),iters)=
- & ihx_use(0,nhx_seed(iters),iters)+1
- ihx_use(2,nhx_seed(iters),iters)=0
- nhx_use(iters)=nhx_use(iters)+1
- endif
- endif
- endif
- endif
- enddo
-
- nhx_tot=nhx_tot+nhx_use(iters)
-cd write (iout,*) "debug N17",iters,nhx_seed(iters),
-cd & nhx_use(iters),nhx_tot
- enddo
-
- if (nhx_tot .ge. n17*nseed) then
- ntot_gen=n17*nseed
- else if (nhx_tot .ge. nseed) then
- ntot_gen=(nhx_tot/nseed)*nseed
- else
- ntot_gen=nhx_tot
- endif
-cd write (iout,*) "debug N17==",ntot_gen,nhx_tot,nseed
-
- ngen=0
- do while (ngen.lt.ntot_gen)
- do iters=1,nseed
- iseed=is(iters)
- if (nhx_use(iters).gt.0) then
-cd write (iout,*) "debug N17",nhx_use(iters),ngen,ntot_gen
-cd write (iout,*) "debugN17^",
-cd & (ihx_use(0,k,iters),k=1,nhx_use(iters))
- nicht_getan=.true.
- do while (nicht_getan)
- iih=iran_num(1,nhx_seed(iters))
-cd write (iout,*) "debugN17^",iih
- if (ihx_use(0,iih,iters).gt.0) then
- iim=iran_num(1,2)
-cd write (iout,*) "debugN17=",iih,nhx_seed(iters)
-cd write (iout,*) "debugN17-",iim,'##',
-cd & (ihx_use(k,iih,iters),k=0,2)
-cd call flush(iout)
- do while (ihx_use(iim,iih,iters).eq.1)
- iim=iran_num(1,2)
-cd write (iout,*) "debugN17-",iim,'##',
-cd & (ihx_use(k,iih,iters),k=0,2)
-cd call flush(iout)
- enddo
- nicht_getan=.false.
- ihx_use(iim,iih,iters)=1
- ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
- nhx_use(iters)=nhx_use(iters)-1
- endif
- enddo
- ngen=ngen+1
- index=index+1
- movenx(index)=17
- parent(1,index)=iseed
- parent(2,index)=0
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- if (iim.eq.1) then
- idata(1,index)=ihx_seed(1,iih,iters)
- idata(2,index)=ihx_seed(2,iih,iters)
- else
- idata(1,index)=ihx_seed(3,iih,iters)
- idata(2,index)=ihx_seed(4,iih,iters)
- endif
-
- if (ngen.eq.ntot_gen) goto 115
- endif
- enddo
- enddo
- 115 continue
- write (iout,*) "N17",n17," ngen/nseed",ngen/nseed,
- & ngen,nseed
-
-
- ENDIF
-c-----------------------------------------
-c N16 : slide non local beta in a seed by +/- 1 or +/- 2
-c
- IF (n16.gt.0) THEN
- nhx_tot=0
- do iters=1,nseed
- i1=is(iters)
- nhx_seed(iters)=0
- do i2=1,n7frag
- if (bvar_frag(i2,1).eq.i1) then
- nhx_seed(iters)=nhx_seed(iters)+1
- ihx_seed(1,nhx_seed(iters),iters)=bvar_frag(i2,3)
- ihx_seed(2,nhx_seed(iters),iters)=bvar_frag(i2,4)
- ihx_seed(3,nhx_seed(iters),iters)=bvar_frag(i2,5)
- ihx_seed(4,nhx_seed(iters),iters)=bvar_frag(i2,6)
- ihx_use(0,nhx_seed(iters),iters)=4
- do i3=1,4
- ihx_use(i3,nhx_seed(iters),iters)=0
- enddo
- endif
- enddo
- nhx_use(iters)=4*nhx_seed(iters)
- nhx_tot=nhx_tot+nhx_seed(iters)
-cd write (iout,*) "debug N16",iters,nhx_seed(iters)
- enddo
-
- if (4*nhx_tot .ge. n16*nseed) then
- ntot_gen=n16*nseed
- else if (4*nhx_tot .ge. nseed) then
- ntot_gen=(4*nhx_tot/nseed)*nseed
- else
- ntot_gen=4*nhx_tot
- endif
- write (iout,*) "debug N16",ntot_gen,4*nhx_tot,nseed
-
- ngen=0
- do while (ngen.lt.ntot_gen)
- do iters=1,nseed
- iseed=is(iters)
- if (nhx_use(iters).gt.0) then
- nicht_getan=.true.
- do while (nicht_getan)
- iih=iran_num(1,nhx_seed(iters))
- if (ihx_use(0,iih,iters).gt.0) then
- iim=iran_num(1,4)
- do while (ihx_use(iim,iih,iters).eq.1)
-cd write (iout,*) iim,
-cd & ihx_use(0,iih,iters),ihx_use(iim,iih,iters)
- iim=iran_num(1,4)
- enddo
- nicht_getan=.false.
- ihx_use(iim,iih,iters)=1
- ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
- nhx_use(iters)=nhx_use(iters)-1
- endif
- enddo
- ngen=ngen+1
- index=index+1
- movenx(index)=16
- parent(1,index)=iseed
- parent(2,index)=0
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do i=1,4
- idata(i,index)=ihx_seed(i,iih,iters)
- enddo
- idata(5,index)=iim
-
- if (ngen.eq.ntot_gen) goto 116
- endif
- enddo
- enddo
- 116 continue
- write (iout,*) "N16",n16," ngen/nseed",ngen/nseed,
- & ngen,nseed
- ENDIF
-c-----------------------------------------
-c N15 : copy two 2nd structure elements from 1 or 2 conf. in bank to a seed
-c
- IF (n15.gt.0) THEN
-
- do iters=1,nseed
- iseed=is(iters)
- do i=1,mxio
- ifused(i)=.false.
- enddo
-
- do idummy=1,n15
- iter=0
- 84 continue
-
- iran=0
- iif=iran_num(1,n15frag)
- do while( (ifused(iif) .or. svar_frag(iif,1).eq.iseed) .and.
- & iran.le.mxio )
- iif=iran_num(1,n15frag)
- iran=iran+1
- enddo
- if(iran.ge.mxio) goto 811
-
- iran=0
- iig=iran_num(1,n15frag)
- do while( (ifused(iig) .or. svar_frag(iig,1).eq.iseed .or.
- & .not.(svar_frag(iif,3).lt.svar_frag(iig,2).or.
- & svar_frag(iig,3).lt.svar_frag(iif,2)) ) .and.
- & iran.le.mxio )
- iig=iran_num(1,n15frag)
- iran=iran+1
- enddo
- if(iran.ge.mxio) goto 811
-
- index=index+1
- movenx(index)=15
- parent(1,index)=iseed
- parent(2,index)=svar_frag(iif,1)
- parent(3,index)=svar_frag(iig,1)
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- ifused(iif)=.true.
- ifused(iig)=.true.
- call newconf_copy(idum,dihang_in(1,1,1,index),
- & svar_frag(iif,1),svar_frag(iif,2),svar_frag(iif,3))
-
- do j=svar_frag(iig,2),svar_frag(iig,3)
- do i=1,4
- dihang_in(i,j,1,index)=bvar(i,j,1,svar_frag(iig,1))
- enddo
- enddo
-
-
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) then
- index=index-1
- ifused(iif)=.false.
- goto 84
- endif
- endif
-
- 811 continue
- enddo
- enddo
- ENDIF
-
-c-----------------------------------------
-c N14 local_move (Maurizio) for loops in a seed
-c
- IF (n14.gt.0) THEN
- nlx_tot=0
- do iters=1,nseed
- i1=is(iters)
- nlx_seed(iters)=0
- do i2=1,n14frag
- if (lvar_frag(i2,1).eq.i1) then
- nlx_seed(iters)=nlx_seed(iters)+3
- ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2)
- ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3)
- ilx_use(nlx_seed(iters),iters)=3
- endif
- enddo
- nlx_use(iters)=nlx_seed(iters)
- nlx_tot=nlx_tot+nlx_seed(iters)
-cd write (iout,*) "debug N14",iters,nlx_seed(iters)
- enddo
-
- if (nlx_tot .ge. n14*nseed) then
- ntot_gen=n14*nseed
- else
- ntot_gen=(nlx_tot/nseed)*nseed
- endif
-cd write (iout,*) "debug N14",ntot_gen,n14frag,nseed
-
- ngen=0
- do while (ngen.lt.ntot_gen)
- do iters=1,nseed
- iseed=is(iters)
- if (nlx_use(iters).gt.0) then
- nicht_getan=.true.
- do while (nicht_getan)
- iih=iran_num(1,nlx_seed(iters))
- if (ilx_use(iih,iters).gt.0) then
- nicht_getan=.false.
- ilx_use(iih,iters)=ilx_use(iih,iters)-1
- nlx_use(iters)=nlx_use(iters)-1
- endif
- enddo
- ngen=ngen+1
- index=index+1
- movenx(index)=14
- parent(1,index)=iseed
- parent(2,index)=0
-
- idata(1,index)=ilx_seed(1,iih,iters)
- idata(2,index)=ilx_seed(2,iih,iters)
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- if (ngen.eq.ntot_gen) goto 131
- endif
- enddo
- enddo
- 131 continue
-cd write (iout,*) "N14",n14," ngen/nseed",ngen/nseed,
-cd & ngen,nseed
-
- ENDIF
-c-----------------------------------------
-c N9 : shift a helix in a seed
-c
- IF (n9.gt.0) THEN
- nhx_tot=0
- do iters=1,nseed
- i1=is(iters)
- nhx_seed(iters)=0
- do i2=1,n8frag
- if (hvar_frag(i2,1).eq.i1) then
- nhx_seed(iters)=nhx_seed(iters)+1
- ihx_seed(1,nhx_seed(iters),iters)=hvar_frag(i2,2)
- ihx_seed(2,nhx_seed(iters),iters)=hvar_frag(i2,3)
- ihx_use(0,nhx_seed(iters),iters)=4
- do i3=1,4
- ihx_use(i3,nhx_seed(iters),iters)=0
- enddo
- endif
- enddo
- nhx_use(iters)=4*nhx_seed(iters)
- nhx_tot=nhx_tot+nhx_seed(iters)
-cd write (iout,*) "debug N9",iters,nhx_seed(iters)
- enddo
-
- if (4*nhx_tot .ge. n9*nseed) then
- ntot_gen=n9*nseed
- else
- ntot_gen=(4*nhx_tot/nseed)*nseed
- endif
-cd write (iout,*) "debug N9",ntot_gen,n8frag,nseed
-
- ngen=0
- do while (ngen.lt.ntot_gen)
- do iters=1,nseed
- iseed=is(iters)
- if (nhx_use(iters).gt.0) then
- nicht_getan=.true.
- do while (nicht_getan)
- iih=iran_num(1,nhx_seed(iters))
- if (ihx_use(0,iih,iters).gt.0) then
- iim=iran_num(1,4)
- do while (ihx_use(iim,iih,iters).eq.1)
-cd write (iout,*) iim,
-cd & ihx_use(0,iih,iters),ihx_use(iim,iih,iters)
- iim=iran_num(1,4)
- enddo
- nicht_getan=.false.
- ihx_use(iim,iih,iters)=1
- ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
- nhx_use(iters)=nhx_use(iters)-1
- endif
- enddo
- ngen=ngen+1
- index=index+1
- movenx(index)=9
- parent(1,index)=iseed
- parent(2,index)=0
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- jstart=max(nnt,ihx_seed(1,iih,iters)+1)
- jend=min(nct,ihx_seed(2,iih,iters))
-cd write (iout,*) "debug N9",iters,iih,jstart,jend
- if (iim.eq.1) then
- ishift=-2
- else if (iim.eq.2) then
- ishift=-1
- else if (iim.eq.3) then
- ishift=1
- else if (iim.eq.4) then
- ishift=2
- else
- write (iout,*) 'CHUJ NASTAPIL: iim=',iim
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
- do j=jstart,jend
- if (itype(j).eq.10) then
- iang=2
- else
- iang=4
- endif
- do i=1,iang
- if (j+ishift.ge.nnt.and.j+ishift.le.nct)
- & dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed)
- enddo
- enddo
- if (ishift.gt.0) then
- do j=0,ishift-1
- if (itype(jend+j).eq.10) then
- iang=2
- else
- iang=4
- endif
- do i=1,iang
- if (jend+j.ge.nnt.and.jend+j.le.nct)
- & dihang_in(i,jstart+j,1,index)=bvar(i,jend+j,1,iseed)
- enddo
- enddo
- else
- do j=0,-ishift-1
- if (itype(jstart+j).eq.10) then
- iang=2
- else
- iang=4
- endif
- do i=1,iang
- if (jend+j.ge.nnt.and.jend+j.le.nct)
- & dihang_in(i,jend+j,1,index)=bvar(i,jstart+j,1,iseed)
- enddo
- enddo
- endif
- if (ngen.eq.ntot_gen) goto 133
- endif
- enddo
- enddo
- 133 continue
-cd write (iout,*) "N9",n9," ngen/nseed",ngen/nseed,
-cd & ngen,nseed
-
- ENDIF
-c-----------------------------------------
-c N8 : copy a helix from bank to seed
-c
- if (n8.gt.0) then
- if (n8frag.lt.n8) then
- write (iout,*) "N8: only ",n8frag,'helices'
- n8c=n8frag
- else
- n8c=n8
- endif
-
- do iters=1,nseed
- iseed=is(iters)
- do i=1,mxio
- ifused(i)=.false.
- enddo
-
-
- do idummy=1,n8c
- iter=0
- 94 continue
- iran=0
- iif=iran_num(1,n8frag)
- do while( (ifused(iif) .or. hvar_frag(iif,1).eq.iseed) .and.
- & iran.le.mxio )
- iif=iran_num(1,n8frag)
- iran=iran+1
- enddo
-
- if(iran.ge.mxio) goto 911
-
- index=index+1
- movenx(index)=8
- parent(1,index)=iseed
- parent(2,index)=hvar_frag(iif,1)
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- ifused(iif)=.true.
- if (hvar_frag(iif,3)-hvar_frag(iif,2).le.6) then
- call newconf_copy(idum,dihang_in(1,1,1,index),
- & hvar_frag(iif,1),hvar_frag(iif,2),hvar_frag(iif,3))
- else
- ih_start=iran_num(hvar_frag(iif,2),hvar_frag(iif,3)-6)
- ih_end=iran_num(ih_start,hvar_frag(iif,3))
- call newconf_copy(idum,dihang_in(1,1,1,index),
- & hvar_frag(iif,1),ih_start,ih_end)
- endif
- iter=iter+1
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) then
- index=index-1
- ifused(iif)=.false.
- goto 94
- endif
- endif
-
-
- 911 continue
-
- enddo
- enddo
-
- endif
-
-c-----------------------------------------
-c N7 : copy nonlocal beta fragment from bank to seed
-c
- if (n7.gt.0) then
- if (n7frag.lt.n7) then
- write (iout,*) "N7: only ",n7frag,'nonlocal fragments'
- n7c=n7frag
- else
- n7c=n7
- endif
-
- do i=1,maxres
- do j=1,mxio2
- iff_in(i,j)=0
- enddo
- enddo
- index2=0
- do i=1,mxio
- isend2(i)=0
- enddo
-
- do iters=1,nseed
- iseed=is(iters)
- do i=1,mxio
- ifused(i)=.false.
- enddo
-
- do idummy=1,n7c
- iran=0
- iif=iran_num(1,n7frag)
- do while( (ifused(iif) .or. bvar_frag(iif,1).eq.iseed) .and.
- & iran.le.mxio )
- iif=iran_num(1,n7frag)
- iran=iran+1
- enddo
-
-cd write (*,'(3i5,l,4i5)'),iters,idummy,iif,ifused(iif),
-cd & bvar_frag(iif,1),iseed,iran,index2
-
- if(iran.ge.mxio) goto 999
- if(index2.ge.mxio2) goto 999
-
- index=index+1
- movenx(index)=7
- parent(1,index)=iseed
- parent(2,index)=bvar_frag(iif,1)
- index2=index2+1
- isend2(index)=index2
- ifused(iif)=.true.
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in2(i,j,k,index2)=bvar(i,j,k,bvar_frag(iif,1))
- enddo
- enddo
- enddo
-
- if (bvar_frag(iif,2).eq.4) then
- do i=bvar_frag(iif,3),bvar_frag(iif,4)
- iff_in(i,index2)=1
- enddo
- if (bvar_frag(iif,5).lt.bvar_frag(iif,6)) then
-cd print *,'###',bvar_frag(iif,3),bvar_frag(iif,4),
-cd & bvar_frag(iif,5),bvar_frag(iif,6)
- do i=bvar_frag(iif,5),bvar_frag(iif,6)
- iff_in(i,index2)=1
- enddo
- else
-cd print *,'###',bvar_frag(iif,3),bvar_frag(iif,4),
-cd & bvar_frag(iif,6),bvar_frag(iif,5)
- do i=bvar_frag(iif,6),bvar_frag(iif,5)
- iff_in(i,index2)=1
- enddo
- endif
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
-
- 999 continue
-
- enddo
- enddo
-
- endif
-c-----------------------------------------------
-c N6 : copy random continues fragment from bank to seed
-c
- do iters=1,nseed
- iseed=is(iters)
- do idummy=1,n6
- isize=(is2-is1+1)*ran1(idum)+is1
- index=index+1
- movenx(index)=6
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- iter=0
- 104 continue
- if(icycle.le.0) then
- i1=nconf* ran1(idum)+1
- i1=nbank-nconf+i1
- else
- i1=nbank* ran1(idum)+1
- endif
- if(i1.eq.iseed) goto 104
- iter=iter+1
- call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
- parent(1,index)=iseed
- parent(2,index)=i1
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 104
- endif
- enddo
- enddo
-c-----------------------------------------
- if (n3.gt.0.or.n4.gt.0) call gen_hairpin
- nconf_harp=0
- do iters=1,nseed
- if (nharp_seed(iters).gt.0) nconf_harp=nconf_harp+1
- enddo
-c-----------------------------------------
-c N3 : copy hairpin from bank to seed
-c
- do iters=1,nseed
- iseed=is(iters)
- nsucc=0
- nacc=0
- do idummy=1,n3
- index=index+1
- iter=0
- 124 continue
- if(icycle.le.0) then
- i1=nconf* ran1(idum)+1
- i1=nbank-nconf+i1
- else
- i1=nbank* ran1(idum)+1
- endif
- if(i1.eq.iseed) goto 124
- do k=1,nsucc
- if (i1.eq.iisucc(k).and.nsucc.lt.nconf_harp-1) goto 124
- enddo
- nsucc=nsucc+1
- iisucc(nsucc)=i1
- iter=iter+1
- call newconf_residue_hairpin(idum,dihang_in(1,1,1,index),
- & i1,fail)
- if (fail) then
- if (icycle.le.0 .and. nsucc.eq.nconf .or.
- & icycle.gt.0 .and. nsucc.eq.nbank) then
- index=index-1
- goto 125
- else
- goto 124
- endif
- endif
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 124
- endif
- movenx(index)=3
- parent(1,index)=iseed
- parent(2,index)=i1
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- nacc=nacc+1
- enddo
-c if not enough hairpins, supplement with windows
- 125 continue
-cdd if (n3.ne.0) write (iout,*) "N3",n3," nsucc",nsucc," nacc",nacc
- do idummy=nacc+1,n3
- isize=(is2-is1+1)*ran1(idum)+is1
- index=index+1
- movenx(index)=6
- parent(1,index)=iseed
- parent(2,index)=i1
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- iter=0
- 114 continue
- if(icycle.le.0) then
- i1=nconf* ran1(idum)+1
- i1=nbank-nconf+i1
- else
- i1=nbank* ran1(idum)+1
- endif
- if(i1.eq.iseed) goto 114
- iter=iter+1
- call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 114
- endif
- enddo
- enddo
-c-----------------------------------------
-c N4 : shift a turn in hairpin in seed
-c
- IF (N4.GT.0) THEN
- if (4*nharp_tot .ge. n4*nseed) then
- ntot_gen=n4*nseed
- else
- ntot_gen=(4*nharp_tot/nseed)*nseed
- endif
- ngen=0
- do while (ngen.lt.ntot_gen)
- do iters=1,nseed
- iseed=is(iters)
-c write (iout,*) 'iters',iters,' iseed',iseed,' nharp_seed',
-c & nharp_seed(iters),' nharp_use',nharp_use(iters),
-c & ' ntot_gen',ntot_gen
-c write (iout,*) 'iharp_use(0)',
-c & (iharp_use(0,k,iters),k=1,nharp_seed(iters))
- if (nharp_use(iters).gt.0) then
- nicht_getan=.true.
- do while (nicht_getan)
- iih=iran_num(1,nharp_seed(iters))
-c write (iout,*) 'iih',iih,' iharp_use',
-c & (iharp_use(k,iih,iters),k=1,4)
- if (iharp_use(0,iih,iters).gt.0) then
- nicht_getan1=.true.
- do while (nicht_getan1)
- iim=iran_num(1,4)
- nicht_getan1=iharp_use(iim,iih,iters).eq.1
- enddo
- nicht_getan=.false.
- iharp_use(iim,iih,iters)=1
- iharp_use(0,iih,iters)=iharp_use(0,iih,iters)-1
- nharp_use(iters)=nharp_use(iters)-1
-cdd write (iout,'(a16,i3,a5,i2,a10,2i4)')
-cdd & 'N4 selected hairpin',iih,' move',iim,' iharp_seed',
-cdd & iharp_seed(1,iih,iters),iharp_seed(2,iih,iters)
- endif
- enddo
- ngen=ngen+1
- index=index+1
- movenx(index)=4
- parent(1,index)=iseed
- parent(2,index)=0
-
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
- jstart=iharp_seed(1,iih,iters)+1
- jend=iharp_seed(2,iih,iters)
- if (iim.eq.1) then
- ishift=-2
- else if (iim.eq.2) then
- ishift=-1
- else if (iim.eq.3) then
- ishift=1
- else if (iim.eq.4) then
- ishift=2
- else
- write (iout,*) 'CHUJ NASTAPIL: iim=',iim
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
-c write (iout,*) 'jstart',jstart,' jend',jend,' ishift',ishift
-c write (iout,*) 'Before turn shift'
-c do j=2,nres-1
-c theta(j+1)=dihang_in(1,j,1,index)
-c phi(j+2)=dihang_in(2,j,1,index)
-c alph(j)=dihang_in(3,j,1,index)
-c omeg(j)=dihang_in(4,j,1,index)
-c enddo
-c call intout
- do j=jstart,jend
- if (itype(j).eq.10) then
- iang=2
- else
- iang=4
- endif
- do i=1,iang
- if (j+ishift.ge.nnt.and.j+ishift.le.nct)
- & dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed)
- enddo
- enddo
-c write (iout,*) 'After turn shift'
-c do j=2,nres-1
-c theta(j+1)=dihang_in(1,j,1,index)
-c phi(j+2)=dihang_in(2,j,1,index)
-c alph(j)=dihang_in(3,j,1,index)
-c omeg(j)=dihang_in(4,j,1,index)
-c enddo
-c call intout
- if (ngen.eq.ntot_gen) goto 135
- endif
- enddo
- enddo
-c if not enough hairpins, supplement with windows
-c write (iout,*) 'end of enddo'
- 135 continue
-cdd write (iout,*) "N4",n4," ngen/nseed",ngen/nseed,
-cdd & ngen,nseed
- do iters=1,nseed
- iseed=is(iters)
- do idummy=ngen/nseed+1,n4
- isize=(is2-is1+1)*ran1(idum)+is1
- index=index+1
- movenx(index)=6
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
-
- iter=0
- 134 continue
- if(icycle.le.0) then
- i1=nconf* ran1(idum)+1
- i1=nbank-nconf+i1
- else
- i1=nbank* ran1(idum)+1
- endif
- if(i1.eq.iseed) goto 134
- iter=iter+1
- call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
- parent(1,index)=iseed
- parent(2,index)=i1
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 134
- endif
- enddo
- enddo
- ENDIF
-c-----------------------------------------
-c N5 : copy one residue from bank to seed (normally switched off - use N1)
-c
- do iters=1,nseed
- iseed=is(iters)
- isize=1
- do i=1,n5
- index=index+1
- movenx(index)=5
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
-
- iter=0
- 105 continue
- if(icycle.le.0) then
- i1=nconf* ran1(idum)+1
- i1=nbank-nconf+i1
- else
- i1=nbank* ran1(idum)+1
- endif
- if(i1.eq.iseed) goto 105
- iter=iter+1
- call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
- parent(1,index)=iseed
- parent(2,index)=i1
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 105
- endif
- enddo
- enddo
-c-----------------------------------------
-c N2 : copy backbone of one residue from bank or first bank to seed
-c (normally switched off - use N1)
-c
- do iters=1,nseed
- iseed=is(iters)
- do i=n2,1,-1
- if(icycle.le.0.and.iuse.gt.nconf-irr) then
- iseed=ran1(idum)*nconf+1
- iseed=nbank-nconf+iseed
- endif
- index=index+1
- movenx(index)=2
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- iter=0
- 102 i1= ran1(idum)*nbank+1
- if(i1.eq.iseed) goto 102
- iter=iter+1
- if(icycle.le.0.and.iuse.gt.nconf-irr) then
- nran=mod(i-1,nran0)+3
- call newconf1arr(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=-iseed
- parent(2,index)=-i1
- else if(icycle.le.0.and.iters.le.iuse) then
- nran=mod(i-1,nran0)+1
- call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=iseed
- parent(2,index)=-i1
- else
- nran=mod(i-1,nran1)+1
- if(ran1(idum).lt.0.5) then
- call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=iseed
- parent(2,index)=-i1
- else
- call newconf1abb(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=iseed
- parent(2,index)=i1
- endif
- endif
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 102
- endif
- enddo
- enddo
-c-----------------------------------------
-c N1 : copy backbone or sidechain of one residue from bank or
-c first bank to seed
-c
- do iters=1,nseed
- iseed=is(iters)
- do i=n1,1,-1
- if(icycle.le.0.and.iuse.gt.nconf-irr) then
- iseed=ran1(idum)*nconf+1
- iseed=nbank-nconf+iseed
- endif
- index=index+1
- movenx(index)=1
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- iter=0
- 101 i1= ran1(idum)*nbank+1
-
- if(i1.eq.iseed) goto 101
- iter=iter+1
- if(icycle.le.0.and.iuse.gt.nconf-irr) then
- nran=mod(i-1,nran0)+3
- call newconf1rr(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=-iseed
- parent(2,index)=-i1
- else if(icycle.le.0.and.iters.le.iuse) then
- nran=mod(i-1,nran0)+1
- call newconf1br(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=iseed
- parent(2,index)=-i1
- else
- nran=mod(i-1,nran1)+1
- if(ran1(idum).lt.0.5) then
- call newconf1br(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=iseed
- parent(2,index)=-i1
- else
- call newconf1bb(idum,dihang_in(1,1,1,index),nran,i1)
- parent(1,index)=iseed
- parent(2,index)=i1
- endif
- endif
- if(iter.lt.10) then
- call check_old(icheck,index)
- if(icheck.eq.1) goto 101
- endif
- enddo
- enddo
-c-----------------------------------------
-c N0 just all seeds
-c
- IF (n0.gt.0) THEN
- do iters=1,nseed
- iseed=is(iters)
- index=index+1
- movenx(index)=0
- parent(1,index)=iseed
- parent(2,index)=0
-
- if (vdisulf) then
- nss_in(index)=bvar_nss(iseed)
- do ij=1,nss_in(index)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- endif
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
- enddo
- ENDIF
-c-----------------------------------------
- if (vdisulf) then
- do iters=1,nseed
- iseed=is(iters)
-
- do k=1,numch
- do j=2,nres-1
- theta(j+1)=bvar(1,j,k,iseed)
- phi(j+2)=bvar(2,j,k,iseed)
- alph(j)=bvar(3,j,k,iseed)
- omeg(j)=bvar(4,j,k,iseed)
- enddo
- enddo
- call chainbuild
-
-cd write(iout,*) 'makevar DYNSS',iseed,'#',bvar_ns(iseed),
-cd & (bvar_s(k,iseed),k=1,bvar_ns(iseed)),
-cd & bvar_nss(iseed),
-cd & (bvar_ss(1,k,iseed)-nres,'-',
-cd & bvar_ss(2,k,iseed)-nres,k=1,bvar_nss(iseed))
-
- do i1=1,bvar_ns(iseed)
-c
-c N10 fussion of free halfcysteines in seed
-c first select CYS with distance < 7A
-c
- do j1=i1+1,bvar_ns(iseed)
- if (dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres)
- & .lt.7.0.and.
- & iabs(bvar_s(i1,iseed)-bvar_s(j1,iseed)).gt.3) then
-
- index=index+1
- movenx(index)=10
- parent(1,index)=iseed
- parent(2,index)=0
- do ij=1,bvar_nss(iseed)
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- enddo
- ij=bvar_nss(iseed)+1
- nss_in(index)=ij
- iss_in(ij,index)=bvar_s(i1,iseed)+nres
- jss_in(ij,index)=bvar_s(j1,iseed)+nres
-
-cd write(iout,*) 'makevar NSS0',index,
-cd & dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres),
-cd & nss_in(index),iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- endif
- enddo
-c
-c N11 type I transdisulfidation
-c
- do j1=1,bvar_nss(iseed)
- if (dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed))
- & .lt.7.0.and.
- & iabs(bvar_s(i1,iseed)-(bvar_ss(1,j1,iseed)-nres))
- & .gt.3) then
-
- index=index+1
- movenx(index)=11
- parent(1,index)=iseed
- parent(2,index)=0
- do ij=1,bvar_nss(iseed)
- if (ij.ne.j1) then
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- endif
- enddo
- nss_in(index)=bvar_nss(iseed)
- iss_in(j1,index)=bvar_s(i1,iseed)+nres
- jss_in(j1,index)=bvar_ss(1,j1,iseed)
- if (iss_in(j1,index).gt.jss_in(j1,index)) then
- iss_in(j1,index)=bvar_ss(1,j1,iseed)
- jss_in(j1,index)=bvar_s(i1,iseed)+nres
- endif
-
-cd write(iout,*) 'makevar NSS1 #1',index,
-cd & bvar_s(i1,iseed),bvar_ss(1,j1,iseed)-nres,
-cd & dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)),
-cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
-cd & ij=1,nss_in(index))
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
- endif
- if (dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed))
- & .lt.7.0.and.
- & iabs(bvar_s(i1,iseed)-(bvar_ss(2,j1,iseed)-nres))
- & .gt.3) then
-
- index=index+1
- movenx(index)=11
- parent(1,index)=iseed
- parent(2,index)=0
- do ij=1,bvar_nss(iseed)
- if (ij.ne.j1) then
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- endif
- enddo
- nss_in(index)=bvar_nss(iseed)
- iss_in(j1,index)=bvar_s(i1,iseed)+nres
- jss_in(j1,index)=bvar_ss(2,j1,iseed)
- if (iss_in(j1,index).gt.jss_in(j1,index)) then
- iss_in(j1,index)=bvar_ss(2,j1,iseed)
- jss_in(j1,index)=bvar_s(i1,iseed)+nres
- endif
-
-
-cd write(iout,*) 'makevar NSS1 #2',index,
-cd & bvar_s(i1,iseed),bvar_ss(2,j1,iseed)-nres,
-cd & dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)),
-cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
-cd & ij=1,nss_in(index))
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- endif
- enddo
- enddo
-
-c
-c N12 type II transdisulfidation
-c
- do i1=1,bvar_nss(iseed)
- do j1=i1+1,bvar_nss(iseed)
- if (dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed))
- & .lt.7.0.and.
- & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed))
- & .lt.7.0.and.
- & iabs(bvar_ss(1,i1,iseed)-bvar_ss(1,j1,iseed))
- & .gt.3.and.
- & iabs(bvar_ss(2,i1,iseed)-bvar_ss(2,j1,iseed))
- & .gt.3) then
- index=index+1
- movenx(index)=12
- parent(1,index)=iseed
- parent(2,index)=0
- do ij=1,bvar_nss(iseed)
- if (ij.ne.i1 .and. ij.ne.j1) then
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- endif
- enddo
- nss_in(index)=bvar_nss(iseed)
- iss_in(i1,index)=bvar_ss(1,i1,iseed)
- jss_in(i1,index)=bvar_ss(1,j1,iseed)
- if (iss_in(i1,index).gt.jss_in(i1,index)) then
- iss_in(i1,index)=bvar_ss(1,j1,iseed)
- jss_in(i1,index)=bvar_ss(1,i1,iseed)
- endif
- iss_in(j1,index)=bvar_ss(2,i1,iseed)
- jss_in(j1,index)=bvar_ss(2,j1,iseed)
- if (iss_in(j1,index).gt.jss_in(j1,index)) then
- iss_in(j1,index)=bvar_ss(2,j1,iseed)
- jss_in(j1,index)=bvar_ss(2,i1,iseed)
- endif
-
-
-cd write(iout,*) 'makevar NSS2 #1',index,
-cd & bvar_ss(1,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres,
-cd & dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)),
-cd & bvar_ss(2,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres,
-cd & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)),
-cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
-cd & ij=1,nss_in(index))
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- endif
-
- if (dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed))
- & .lt.7.0.and.
- & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed))
- & .lt.7.0.and.
- & iabs(bvar_ss(1,i1,iseed)-bvar_ss(2,j1,iseed))
- & .gt.3.and.
- & iabs(bvar_ss(2,i1,iseed)-bvar_ss(1,j1,iseed))
- & .gt.3) then
- index=index+1
- movenx(index)=12
- parent(1,index)=iseed
- parent(2,index)=0
- do ij=1,bvar_nss(iseed)
- if (ij.ne.i1 .and. ij.ne.j1) then
- iss_in(ij,index)=bvar_ss(1,ij,iseed)
- jss_in(ij,index)=bvar_ss(2,ij,iseed)
- endif
- enddo
- nss_in(index)=bvar_nss(iseed)
- iss_in(i1,index)=bvar_ss(1,i1,iseed)
- jss_in(i1,index)=bvar_ss(2,j1,iseed)
- if (iss_in(i1,index).gt.jss_in(i1,index)) then
- iss_in(i1,index)=bvar_ss(2,j1,iseed)
- jss_in(i1,index)=bvar_ss(1,i1,iseed)
- endif
- iss_in(j1,index)=bvar_ss(2,i1,iseed)
- jss_in(j1,index)=bvar_ss(1,j1,iseed)
- if (iss_in(j1,index).gt.jss_in(j1,index)) then
- iss_in(j1,index)=bvar_ss(1,j1,iseed)
- jss_in(j1,index)=bvar_ss(2,i1,iseed)
- endif
-
-
-cd write(iout,*) 'makevar NSS2 #2',index,
-cd & bvar_ss(1,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres,
-cd & dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)),
-cd & bvar_ss(2,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres,
-cd & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)),
-cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
-cd & ij=1,nss_in(index))
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- endif
-
-
- enddo
- enddo
-c
-c N13 removal of disulfide bond
-c
- if (bvar_nss(iseed).gt.0) then
- i1=bvar_nss(iseed)*ran1(idum)+1
-
- index=index+1
- movenx(index)=13
- parent(1,index)=iseed
- parent(2,index)=0
- ij=0
- do j1=1,bvar_nss(iseed)
- if (j1.ne.i1) then
- ij=ij+1
- iss_in(ij,index)=bvar_ss(1,j1,iseed)
- jss_in(ij,index)=bvar_ss(2,j1,iseed)
- endif
- enddo
- nss_in(index)=bvar_nss(iseed)-1
-
-cd write(iout,*) 'NSS3',index,i1,
-cd & bvar_ss(1,i1,iseed)-nres,'=',bvar_ss(2,i1,iseed)-nres,'#',
-cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
-cd & ij=1,nss_in(index))
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- endif
-
- enddo
- endif
-c-----------------------------------------
-
-
-
- if(index.ne.n) write(iout,*)'make_var : ntry=',index
-
- n=index
-cd do ii=1,n
-cd write (istat,*) "======== ii=",ii," the dihang array"
-cd do i=1,nres
-cd write (istat,'(i5,4f15.5)') i,(dihang_in(k,i,1,ii)*rad2deg,k=1,4)
-cd enddo
-cd enddo
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine check_old(icheck,n)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- data ctdif /10./
- data ctdiff /60./
-
- i1=n
- do i2=1,n-1
- diff=0.d0
- do m=1,numch
- do j=2,nres-1
- do i=1,4
- dif=rad2deg*dabs(dihang_in(i,j,m,i1)-dihang_in(i,j,m,i2))
- if(dif.gt.180.0) dif=360.0-dif
- if(dif.gt.ctdif) goto 100
- diff=diff+dif
- if(diff.gt.ctdiff) goto 100
- enddo
- enddo
- enddo
- icheck=1
- return
- 100 continue
- enddo
-
- icheck=0
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf1rr(idum,vvar,nran,i1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=rvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do index=1,nran
- iold(index) = 0
- enddo
-
- number=ntotgr
-
- iter=0
- do index=1,nran
- 10 iran= ran1(idum)*number+1
- if(iter.gt.number) return
- iter=iter+1
- if(iter.eq.1) goto 11
- do ind=1,index-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- if(iter.gt.number) goto 20
- goto 10
- 20 continue
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- vvar(i,j,k)=rvar(i,j,k,i1)
- enddo
- iold(index)=iran
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf1br(idum,vvar,nran,i1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do index=1,nran
- iold(index) = 0
- enddo
-
- number=ntotgr
-
- iter=0
- do index=1,nran
- 10 iran= ran1(idum)*number+1
- if(i2ndstr.gt.0) then
- rtmp=ran1(idum)
- if(rtmp.le.rdih_bias) then
- i=0
- do j=1,ndih_nconstr
- if(igroup(2,1,iran).eq.idih_nconstr(j))i=j
- enddo
- if(i.eq.0) then
- juhc=0
-4321 juhc=juhc+1
- iran= ran1(idum)*number+1
- i=0
- do j=1,ndih_nconstr
- if(igroup(2,1,iran).eq.idih_nconstr(j))i=j
- enddo
- if(i.eq.0.or.juhc.lt.1000)goto 4321
- if(juhc.eq.1000) then
- print *, 'move 6 : failed to find unconstrained group'
- write(iout,*) 'move 6 : failed to find unconstrained group'
- endif
- endif
- endif
- endif
- if(iter.gt.number) return
- iter=iter+1
- if(iter.eq.1) goto 11
- do ind=1,index-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- if(iter.gt.number) goto 20
- goto 10
- 20 continue
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- vvar(i,j,k)=rvar(i,j,k,i1)
- enddo
- iold(index)=iran
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf1bb(idum,vvar,nran,i1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do index=1,nran
- iold(index) = 0
- enddo
-
- number=ntotgr
-
- iter=0
- do index=1,nran
- 10 iran= ran1(idum)*number+1
- if(iter.gt.number) return
- iter=iter+1
- if(iter.eq.1) goto 11
- do ind=1,index-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- if(iter.gt.number) goto 20
- goto 10
- 20 continue
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- vvar(i,j,k)=bvar(i,j,k,i1)
- enddo
- iold(index)=iran
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf1arr(idum,vvar,nran,i1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=rvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do index=1,nran
- iold(index) = 0
- enddo
-
- number=nres-2
-
- iter=0
- do index=1,nran
- 10 iran= ran1(idum)*number+1
- if(iter.gt.number) return
- iter=iter+1
- if(iter.eq.1) goto 11
- do ind=1,index-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- if(iter.gt.number) goto 20
- goto 10
- 20 continue
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- vvar(i,j,k)=rvar(i,j,k,i1)
- enddo
- iold(index)=iran
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf1abr(idum,vvar,nran,i1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do index=1,nran
- iold(index) = 0
- enddo
-
- number=nres-2
-
- iter=0
- do index=1,nran
- 10 iran= ran1(idum)*number+1
- if(i2ndstr.gt.0) then
- rtmp=ran1(idum)
- if(rtmp.le.rdih_bias) then
- iran=ran1(idum)*ndih_nconstr+1
- iran=idih_nconstr(iran)
- endif
- endif
- if(iter.gt.number) return
- iter=iter+1
- if(iter.eq.1) goto 11
- do ind=1,index-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- if(iter.gt.number) goto 20
- goto 10
- 20 continue
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- vvar(i,j,k)=rvar(i,j,k,i1)
- enddo
- iold(index)=iran
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf1abb(idum,vvar,nran,i1)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
- do index=1,nran
- iold(index) = 0
- enddo
-
- number=nres-2
-
- iter=0
- do index=1,nran
- 10 iran= ran1(idum)*number+1
- if(i2ndstr.gt.0) then
- rtmp=ran1(idum)
- if(rtmp.le.rdih_bias) then
- iran=ran1(idum)*ndih_nconstr+1
- iran=idih_nconstr(iran)
- endif
- endif
- if(iter.gt.number) return
- iter=iter+1
- if(iter.eq.1) goto 11
- do ind=1,index-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- if(iter.gt.number) goto 20
- goto 10
- 20 continue
- do ind=1,ngroup(iran)
- i=igroup(1,ind,iran)
- j=igroup(2,ind,iran)
- k=igroup(3,ind,iran)
- vvar(i,j,k)=bvar(i,j,k,i1)
- enddo
- iold(index)=iran
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf_residue(idum,vvar,i1,isize)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- if (iseed.gt.mxio .or. iseed.lt.1) then
- write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
-
- k=1
- number=nres+isize-2
- iter=1
- 10 iran= ran1(idum)*number+1
- if(i2ndstr.gt.0) then
- rtmp=ran1(idum)
- if(rtmp.le.rdih_bias) then
- iran=ran1(idum)*ndih_nconstr+1
- iran=idih_nconstr(iran)
- endif
- endif
- istart=iran-isize+1
- iend=iran
- if(istart.lt.2) istart=2
- if(iend.gt.nres-1) iend=nres-1
-
- if(iter.eq.1) goto 11
- do ind=1,iter-1
- if(iran.eq.iold(ind)) goto 10
- enddo
- 11 continue
-
- do j=istart,iend
- do i=1,4
- dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- enddo
- iold(iter)=iran
- iter=iter+1
- if(iter.gt.number) goto 20
- goto 10
-
- 20 continue
- do j=istart,iend
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,i1)
- enddo
- enddo
-
- return
- end
-
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf_copy(idum,vvar,i1,istart,iend)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.TORCNSTR'
- include 'COMMON.CONTROL'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- ctdif=10.
-
- if (iseed.gt.mxio .or. iseed.lt.1) then
- write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
-
-
- do j=istart,iend
- do i=1,4
- vvar(i,j,1)=bvar(i,j,1,i1)
- enddo
- enddo
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine newconf_residue_hairpin(idum,vvar,i1,fail)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- real ran1,ran2
- dimension vvar(mxang,maxres,mxch),iold(ntotal)
- integer nharp,iharp(4,maxres/3),icipa(maxres/3)
- logical fail,not_done
- ctdif=10.
-
- fail=.false.
- if (iseed.gt.mxio .or. iseed.lt.1) then
- write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
- call mpi_abort(mpi_comm_world,ierror,ierrcode)
- endif
- do k=1,numch
- do j=2,nres-1
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,iseed)
- enddo
- enddo
- enddo
- do k=1,numch
- do j=2,nres-1
- theta(j+1)=bvar(1,j,k,i1)
- phi(j+2)=bvar(2,j,k,i1)
- alph(j)=bvar(3,j,k,i1)
- omeg(j)=bvar(4,j,k,i1)
- enddo
- enddo
-c call intout
- call chainbuild
- call hairpin(.false.,nharp,iharp)
-
- if (nharp.eq.0) then
- fail=.true.
- return
- endif
-
- n_used=0
-
- DO III=1,NHARP
-
- not_done = .true.
- icount=0
- do while (not_done)
- icount=icount+1
- iih=iran_num(1,nharp)
- do k=1,n_used
- if (iih.eq.icipa(k)) then
- iih=0
- goto 22
- endif
- enddo
- not_done=.false.
- n_used=n_used+1
- icipa(n_used)=iih
- 22 continue
- not_done = not_done .and. icount.le.nharp
- enddo
-
- if (iih.eq.0) then
- write (iout,*) "CHUJ NASTAPIL W NEWCONF_RESIDUE_HAIRPIN!!!!"
- fail=.true.
- return
- endif
-
- istart=iharp(1,iih)+1
- iend=iharp(2,iih)
-
-cdd write (iout,*) "newconf_residue_hairpin: iih",iih,
-cdd & " istart",istart," iend",iend
-
- do k=1,numch
- do j=istart,iend
- do i=1,4
- dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
- if(dif.gt.180.) dif=360.-dif
- if(dif.gt.ctdif) goto 20
- enddo
- enddo
- enddo
- goto 10
- 20 continue
- do k=1,numch
- do j=istart,iend
- do i=1,4
- vvar(i,j,k)=bvar(i,j,k,i1)
- enddo
- enddo
- enddo
-c do j=1,numch
-c do l=2,nres-1
-c write (iout,'(4f8.3)') (rad2deg*vvar(i,l,j),i=1,4)
-c enddo
-c enddo
- return
- 10 continue
- ENDDO
-
- fail=.true.
-
- return
- end
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine gen_hairpin
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.HAIRPIN'
-
-c write (iout,*) 'Entering GEN_HAIRPIN'
- do iters=1,nseed
- i1=is(iters)
- do k=1,numch
- do j=2,nres-1
- theta(j+1)=bvar(1,j,k,i1)
- phi(j+2)=bvar(2,j,k,i1)
- alph(j)=bvar(3,j,k,i1)
- omeg(j)=bvar(4,j,k,i1)
- enddo
- enddo
- call chainbuild
- call hairpin(.false.,nharp_seed(iters),iharp_seed(1,1,iters))
- enddo
-
- nharp_tot=0
- do iters=1,nseed
- nharp_tot=nharp_tot+nharp_seed(iters)
- nharp_use(iters)=4*nharp_seed(iters)
- do j=1,nharp_seed(iters)
- iharp_use(0,j,iters)=4
- do k=1,4
- iharp_use(k,j,iters)=0
- enddo
- enddo
- enddo
-
- write (iout,*) 'GEN_HAIRPIN: nharp_tot',nharp_tot
-cdd do i=1,nseed
-cdd write (iout,*) 'seed',i
-cdd write (iout,*) 'nharp_seed',nharp_seed(i),
-cdd & ' nharp_use',nharp_use(i)
-cd write (iout,*) 'iharp_seed, iharp_use'
-cd do j=1,nharp_seed(i)
-cd write (iout,'(7i3)') iharp_seed(1,j,i),iharp_seed(2,j,i),
-cd & (iharp_use(k,j,i),k=0,4)
-cd enddo
-cdd enddo
- return
- end
-
-ccccccccccccccccccccccccccccccccccccccccccccccccc
-ccccccccccccccccccccccccccccccccccccccccccccccccc
- subroutine select_frag(nn,nh,nl,ns,nb,i_csa)
- implicit real*8 (a-h,o-z)
- include 'DIMENSIONS'
- include 'COMMON.IOUNITS'
- include 'COMMON.CSA'
- include 'COMMON.BANK'
- include 'COMMON.CHAIN'
- include 'COMMON.GEO'
- include 'COMMON.VAR'
- include 'COMMON.HAIRPIN'
- include 'COMMON.DISTFIT'
- character*50 linia
- integer isec(maxres)
-
-
- nn=0
- nh=0
- nl=0
- ns=0
- nb=0
-cd write (iout,*) 'Entering select_frag'
- do i1=1,nbank
- do i=1,nres
- isec(i)=0
- enddo
- do k=1,numch
- do j=2,nres-1
- theta(j+1)=bvar(1,j,k,i1)
- phi(j+2)=bvar(2,j,k,i1)
- alph(j)=bvar(3,j,k,i1)
- omeg(j)=bvar(4,j,k,i1)
- enddo
- enddo
- call chainbuild
-cd write (iout,*) ' -- ',i1,' -- '
- call secondary2(.false.)
-c
-c bvar_frag nn==pair of nonlocal strands in beta sheet (loop>4)
-c strands > 4 residues; used by N7 and N16
-c
- do j=1,nbfrag
-c
-Ctest 09/12/02 bfrag(2,j)-bfrag(1,j).gt.3
-c
- do i=bfrag(1,j),bfrag(2,j)
- isec(i)=1
- enddo
- do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j))
- isec(i)=1
- enddo
-
- if ( (bfrag(3,j).lt.bfrag(4,j) .or.
- & bfrag(4,j)-bfrag(2,j).gt.4) .and.
- & bfrag(2,j)-bfrag(1,j).gt.4 ) then
- nn=nn+1
-
-
- if (bfrag(3,j).lt.bfrag(4,j)) then
- write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
- & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1
- & ,",",bfrag(3,j)-1,"-",bfrag(4,j)-1
- else
- write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
- & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1
- & ,",",bfrag(4,j)-1,"-",bfrag(3,j)-1
-
- endif
-cd call write_pdb(i_csa*1000+nn+nh,linia,0d0)
-
- bvar_frag(nn,1)=i1
- bvar_frag(nn,2)=4
- do i=1,4
- bvar_frag(nn,i+2)=bfrag(i,j)
- enddo
- endif
- enddo
-
-c
-c hvar_frag nh==helices; used by N8 and N9
-c
- do j=1,nhfrag
-
- do i=hfrag(1,j),hfrag(2,j)
- isec(i)=2
- enddo
-
- if ( hfrag(2,j)-hfrag(1,j).gt.4 ) then
- nh=nh+1
-
-cd write(linia,'(a6,i3,a1,i3)')
-cd & "select",hfrag(1,j)-1,"-",hfrag(2,j)-1
-cd call write_pdb(i_csa*1000+nn+nh,linia,0d0)
-
- hvar_frag(nh,1)=i1
- hvar_frag(nh,2)=hfrag(1,j)
- hvar_frag(nh,3)=hfrag(2,j)
- endif
- enddo
-
-
-cv write(iout,'(i4,1pe12.4,1x,1000i1)')
-cv & i1,bene(i1),(isec(i),i=1,nres)
-cv write(linia,'(i4,1x,1000i1)')
-cv & i1,(isec(i),i=1,nres)
-cv call write_pdb(i_csa*1000+i1,linia,bene(i1))
-c
-c lvar_frag nl==loops; used by N14
-c
- i=1
- nl1=nl
- do while (i.lt.nres)
- if (isec(i).eq.0) then
- nl=nl+1
- lvar_frag(nl,1)=i1
- lvar_frag(nl,2)=i
- i=i+1
- do while (isec(i).eq.0.and.i.le.nres)
- i=i+1
- enddo
- lvar_frag(nl,3)=i-1
- if (lvar_frag(nl,3)-lvar_frag(nl,2).lt.1) nl=nl-1
- endif
- i=i+1
- enddo
-cd write(iout,'(4i5)') (i,(lvar_frag(i,ii),ii=1,3),i=nl1+1,nl)
-
-c
-c svar_frag ns==an secondary structure element; used by N15
-c
- i=1
- ns1=ns
- do while (i.lt.nres)
- if (isec(i).gt.0) then
- ns=ns+1
- svar_frag(ns,1)=i1
- svar_frag(ns,2)=i
- i=i+1
- do while (isec(i).gt.0.and.isec(i-1).eq.isec(i)
- & .and.i.le.nres)
- i=i+1
- enddo
- svar_frag(ns,3)=i-1
- if (svar_frag(ns,3)-svar_frag(ns,2).lt.1) ns=ns-1
- endif
- if (isec(i).eq.0) i=i+1
- enddo
-cd write(iout,'(4i5)') (i,(svar_frag(i,ii),ii=1,3),i=ns1+1,ns)
-
-c
-c avar_frag nb==any pair of beta strands; used by N17
-c
- do j=1,nbfrag
- nb=nb+1
- avar_frag(nb,1)=i1
- do i=1,4
- avar_frag(nb,i+1)=bfrag(i,j)
- enddo
- enddo
-
- enddo
-
- return
- end
projects / unres.git / commitdiff