--- /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 / blobdiff