source/unres/src_CSA/newconf.f

   1 ccccccccccccccccccccccccccccccccccccccccccccccccc
   2 ccccccccccccccccccccccccccccccccccccccccccccccccc
   3       subroutine make_var(n,idum,iter_csa)
   4       implicit real*8 (a-h,o-z)
   5       include 'DIMENSIONS'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.CSA'
   8       include 'COMMON.BANK'
   9       include 'COMMON.CHAIN'
  10       include 'COMMON.INTERACT'
  11       include 'COMMON.HAIRPIN'
  12       include 'COMMON.VAR'
  13       include 'COMMON.DISTFIT'
  14       include 'COMMON.GEO'
  15       include 'COMMON.CONTROL'
  16       logical nicht_getan,nicht_getan1,fail,lfound
  17       integer nharp,iharp(4,maxres/3),nconf_harp
  18       integer iisucc(mxio)
  19       logical ifused(mxio)
  20       integer nhx_seed(max_seed),ihx_seed(4,maxres/3,max_seed)
  21       integer nhx_use(max_seed),ihx_use(0:4,maxres/3,max_seed)
  22       integer nlx_seed(max_seed),ilx_seed(2,maxres/3,max_seed),
  23      &         nlx_use(max_seed),ilx_use(maxres/3,max_seed)
  24       real ran1,ran2
  25
  26       write (iout,*) 'make_var : nseed=',nseed,'ntry=',n
  27       index=0
  28
  29 c-----------------------------------------
  30       if (n7.gt.0.or.n8.gt.0.or.n9.gt.0.or.n14.gt.0.or.n15.gt.0
  31      &    .or.n16.gt.0.or.n17.gt.0.or.n18.gt.0)
  32      &           call select_frag(n7frag,n8frag,n14frag,
  33      &           n15frag,nbefrag,iter_csa)
  34
  35 c---------------------------------------------------
  36 c N18 - random perturbation of one phi(=gamma) angle in a loop
  37 c
  38       IF (n18.gt.0) THEN
  39       nlx_tot=0
  40       do iters=1,nseed
  41         i1=is(iters)
  42         nlx_seed(iters)=0
  43         do i2=1,n14frag
  44           if (lvar_frag(i2,1).eq.i1) then
  45             nlx_seed(iters)=nlx_seed(iters)+5
  46             ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2)
  47             ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3)
  48             ilx_use(nlx_seed(iters),iters)=5
  49           endif
  50         enddo
  51         nlx_use(iters)=nlx_seed(iters)
  52         nlx_tot=nlx_tot+nlx_seed(iters)
  53       enddo
  54
  55       if (nlx_tot .ge. n18*nseed) then
  56         ntot_gen=n18*nseed
  57       else
  58         ntot_gen=(nlx_tot/nseed)*nseed
  59       endif
  60
  61       ngen=0
  62       do while (ngen.lt.ntot_gen)
  63       do iters=1,nseed
  64         iseed=is(iters)
  65         if (nlx_use(iters).gt.0) then
  66           nicht_getan=.true.
  67           do while (nicht_getan)
  68             iih=iran_num(1,nlx_seed(iters))
  69             if (ilx_use(iih,iters).gt.0) then
  70               nicht_getan=.false.
  71               ilx_use(iih,iters)=ilx_use(iih,iters)-1
  72               nlx_use(iters)=nlx_use(iters)-1
  73             endif
  74           enddo
  75           ngen=ngen+1
  76           index=index+1
  77           movenx(index)=18
  78           parent(1,index)=iseed
  79           parent(2,index)=0
  80
  81
  82            if (vdisulf) then
  83              nss_in(index)=bvar_nss(iseed)
  84              do ij=1,nss_in(index)
  85                iss_in(ij,index)=bvar_ss(1,ij,iseed)
  86                jss_in(ij,index)=bvar_ss(2,ij,iseed)
  87              enddo
  88            endif
  89
  90
  91           do k=1,numch
  92             do j=2,nres-1
  93               do i=1,4
  94                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
  95               enddo
  96             enddo
  97           enddo
  98
  99           jr=iran_num(ilx_seed(1,iih,iters),ilx_seed(2,iih,iters))
 100           d=ran_number(-pi,pi)
 101           dihang_in(2,jr-2,1,index)=pinorm(dihang_in(2,jr-2,1,index)+d)
 102
 103
 104           if (ngen.eq.ntot_gen) goto 145
 105         endif
 106       enddo
 107       enddo
 108   145 continue
 109
 110       ENDIF
 111
 112
 113 c-----------------------------------------
 114 c N17 : zip a beta in a seed by forcing one additional p-p contact
 115 c
 116       IF (n17.gt.0) THEN
 117       nhx_tot=0
 118       do iters=1,nseed
 119         i1=is(iters)
 120         nhx_seed(iters)=0
 121         nhx_use(iters)=0
 122         do i2=1,nbefrag
 123           if (avar_frag(i2,1).eq.i1) then
 124             nhx_seed(iters)=nhx_seed(iters)+1
 125             ihx_use(2,nhx_seed(iters),iters)=1
 126             if (avar_frag(i2,5)-avar_frag(i2,3).le.3.and.
 127      &           avar_frag(i2,2).gt.1.and.avar_frag(i2,4).lt.nres) then
 128              ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
 129              ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1
 130              ihx_use(0,nhx_seed(iters),iters)=1
 131              ihx_use(1,nhx_seed(iters),iters)=0
 132              nhx_use(iters)=nhx_use(iters)+1
 133             else
 134               if (avar_frag(i2,4).gt.avar_frag(i2,5)) then
 135                if (avar_frag(i2,2).gt.1.and.
 136      &                     avar_frag(i2,4).lt.nres) then
 137                 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
 138                 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1
 139                 ihx_use(0,nhx_seed(iters),iters)=1
 140                 ihx_use(1,nhx_seed(iters),iters)=0
 141                 nhx_use(iters)=nhx_use(iters)+1
 142                endif
 143                if (avar_frag(i2,3).lt.nres.and.
 144      &                     avar_frag(i2,5).gt.1) then
 145                 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1
 146                 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)-1
 147                 ihx_use(0,nhx_seed(iters),iters)=
 148      &                    ihx_use(0,nhx_seed(iters),iters)+1
 149                 ihx_use(2,nhx_seed(iters),iters)=0
 150                 nhx_use(iters)=nhx_use(iters)+1
 151                endif
 152               else
 153                if (avar_frag(i2,2).gt.1.and.
 154      &                     avar_frag(i2,4).gt.1) then
 155                 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1
 156                 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)-1
 157                 ihx_use(0,nhx_seed(iters),iters)=1
 158                 ihx_use(1,nhx_seed(iters),iters)=0
 159                 nhx_use(iters)=nhx_use(iters)+1
 160                endif
 161                if (avar_frag(i2,3).lt.nres.and.
 162      &                     avar_frag(i2,5).lt.nres) then
 163                 ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1
 164                 ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)+1
 165                 ihx_use(0,nhx_seed(iters),iters)=
 166      &                    ihx_use(0,nhx_seed(iters),iters)+1
 167                 ihx_use(2,nhx_seed(iters),iters)=0
 168                 nhx_use(iters)=nhx_use(iters)+1
 169                endif
 170               endif
 171             endif
 172           endif
 173         enddo
 174
 175         nhx_tot=nhx_tot+nhx_use(iters)
 176 cd        write (iout,*) "debug N17",iters,nhx_seed(iters),
 177 cd     &                     nhx_use(iters),nhx_tot
 178       enddo
 179
 180       if (nhx_tot .ge. n17*nseed) then
 181         ntot_gen=n17*nseed
 182       else if (nhx_tot .ge. nseed) then
 183         ntot_gen=(nhx_tot/nseed)*nseed
 184       else
 185         ntot_gen=nhx_tot
 186       endif
 187 cd      write (iout,*) "debug N17==",ntot_gen,nhx_tot,nseed
 188
 189       ngen=0
 190       do while (ngen.lt.ntot_gen)
 191       do iters=1,nseed
 192         iseed=is(iters)
 193         if (nhx_use(iters).gt.0) then
 194 cd          write (iout,*) "debug N17",nhx_use(iters),ngen,ntot_gen
 195 cd          write (iout,*) "debugN17^",
 196 cd     &                    (ihx_use(0,k,iters),k=1,nhx_use(iters))
 197           nicht_getan=.true.
 198           do while (nicht_getan)
 199             iih=iran_num(1,nhx_seed(iters))
 200 cd            write (iout,*) "debugN17^",iih
 201             if (ihx_use(0,iih,iters).gt.0) then
 202               iim=iran_num(1,2)
 203 cd                write (iout,*) "debugN17=",iih,nhx_seed(iters)
 204 cd                write (iout,*) "debugN17-",iim,'##',
 205 cd     &                           (ihx_use(k,iih,iters),k=0,2)
 206 cd                call flush(iout)
 207               do while (ihx_use(iim,iih,iters).eq.1)
 208                 iim=iran_num(1,2)
 209 cd                write (iout,*) "debugN17-",iim,'##',
 210 cd     &                           (ihx_use(k,iih,iters),k=0,2)
 211 cd                call flush(iout)
 212               enddo
 213               nicht_getan=.false.
 214               ihx_use(iim,iih,iters)=1
 215               ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
 216               nhx_use(iters)=nhx_use(iters)-1
 217             endif
 218           enddo
 219           ngen=ngen+1
 220           index=index+1
 221           movenx(index)=17
 222           parent(1,index)=iseed
 223           parent(2,index)=0
 224
 225            if (vdisulf) then
 226              nss_in(index)=bvar_nss(iseed)
 227              do ij=1,nss_in(index)
 228                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 229                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 230              enddo
 231            endif
 232
 233           do k=1,numch
 234             do j=2,nres-1
 235               do i=1,4
 236                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
 237               enddo
 238             enddo
 239           enddo
 240
 241           if (iim.eq.1) then
 242             idata(1,index)=ihx_seed(1,iih,iters)
 243             idata(2,index)=ihx_seed(2,iih,iters)
 244           else
 245             idata(1,index)=ihx_seed(3,iih,iters)
 246             idata(2,index)=ihx_seed(4,iih,iters)
 247           endif
 248
 249           if (ngen.eq.ntot_gen) goto 115
 250         endif
 251       enddo
 252       enddo
 253   115 continue
 254       write (iout,*) "N17",n17," ngen/nseed",ngen/nseed,
 255      &                           ngen,nseed
 256
 257
 258       ENDIF
 259 c-----------------------------------------
 260 c N16 : slide non local beta in a seed by +/- 1 or +/- 2
 261 c
 262       IF (n16.gt.0) THEN
 263       nhx_tot=0
 264       do iters=1,nseed
 265         i1=is(iters)
 266         nhx_seed(iters)=0
 267         do i2=1,n7frag
 268           if (bvar_frag(i2,1).eq.i1) then
 269             nhx_seed(iters)=nhx_seed(iters)+1
 270             ihx_seed(1,nhx_seed(iters),iters)=bvar_frag(i2,3)
 271             ihx_seed(2,nhx_seed(iters),iters)=bvar_frag(i2,4)
 272             ihx_seed(3,nhx_seed(iters),iters)=bvar_frag(i2,5)
 273             ihx_seed(4,nhx_seed(iters),iters)=bvar_frag(i2,6)
 274             ihx_use(0,nhx_seed(iters),iters)=4
 275             do i3=1,4
 276               ihx_use(i3,nhx_seed(iters),iters)=0
 277             enddo
 278           endif
 279         enddo
 280         nhx_use(iters)=4*nhx_seed(iters)
 281         nhx_tot=nhx_tot+nhx_seed(iters)
 282 cd        write (iout,*) "debug N16",iters,nhx_seed(iters)
 283       enddo
 284
 285       if (4*nhx_tot .ge. n16*nseed) then
 286         ntot_gen=n16*nseed
 287       else if (4*nhx_tot .ge. nseed) then
 288         ntot_gen=(4*nhx_tot/nseed)*nseed
 289       else
 290         ntot_gen=4*nhx_tot
 291       endif
 292       write (iout,*) "debug N16",ntot_gen,4*nhx_tot,nseed
 293
 294       ngen=0
 295       do while (ngen.lt.ntot_gen)
 296       do iters=1,nseed
 297         iseed=is(iters)
 298         if (nhx_use(iters).gt.0) then
 299           nicht_getan=.true.
 300           do while (nicht_getan)
 301             iih=iran_num(1,nhx_seed(iters))
 302             if (ihx_use(0,iih,iters).gt.0) then
 303               iim=iran_num(1,4)
 304               do while (ihx_use(iim,iih,iters).eq.1)
 305 cd                write (iout,*) iim,
 306 cd     &                ihx_use(0,iih,iters),ihx_use(iim,iih,iters)
 307                 iim=iran_num(1,4)
 308               enddo
 309               nicht_getan=.false.
 310               ihx_use(iim,iih,iters)=1
 311               ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
 312               nhx_use(iters)=nhx_use(iters)-1
 313             endif
 314           enddo
 315           ngen=ngen+1
 316           index=index+1
 317           movenx(index)=16
 318           parent(1,index)=iseed
 319           parent(2,index)=0
 320
 321            if (vdisulf) then
 322              nss_in(index)=bvar_nss(iseed)
 323              do ij=1,nss_in(index)
 324                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 325                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 326              enddo
 327            endif
 328
 329           do k=1,numch
 330             do j=2,nres-1
 331               do i=1,4
 332                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
 333               enddo
 334             enddo
 335           enddo
 336
 337           do i=1,4
 338            idata(i,index)=ihx_seed(i,iih,iters)
 339           enddo
 340           idata(5,index)=iim
 341
 342           if (ngen.eq.ntot_gen) goto 116
 343         endif
 344       enddo
 345       enddo
 346   116 continue
 347       write (iout,*) "N16",n16," ngen/nseed",ngen/nseed,
 348      &                           ngen,nseed
 349       ENDIF
 350 c-----------------------------------------
 351 c N15 : copy two 2nd structure elements from 1 or 2 conf. in bank to a seed
 352 c
 353       IF (n15.gt.0) THEN
 354
 355        do iters=1,nseed
 356          iseed=is(iters)
 357          do i=1,mxio
 358            ifused(i)=.false.
 359          enddo
 360
 361          do idummy=1,n15
 362            iter=0
 363    84      continue
 364
 365            iran=0
 366            iif=iran_num(1,n15frag)
 367            do while( (ifused(iif) .or. svar_frag(iif,1).eq.iseed) .and.
 368      &                      iran.le.mxio )
 369             iif=iran_num(1,n15frag)
 370             iran=iran+1
 371            enddo
 372            if(iran.ge.mxio) goto 811
 373
 374            iran=0
 375            iig=iran_num(1,n15frag)
 376            do while( (ifused(iig) .or. svar_frag(iig,1).eq.iseed  .or.
 377      &             .not.(svar_frag(iif,3).lt.svar_frag(iig,2).or.
 378      &                   svar_frag(iig,3).lt.svar_frag(iif,2)) ) .and.
 379      &                      iran.le.mxio )
 380             iig=iran_num(1,n15frag)
 381             iran=iran+1
 382            enddo
 383            if(iran.ge.mxio) goto 811
 384
 385            index=index+1
 386            movenx(index)=15
 387            parent(1,index)=iseed
 388            parent(2,index)=svar_frag(iif,1)
 389            parent(3,index)=svar_frag(iig,1)
 390
 391
 392            if (vdisulf) then
 393              nss_in(index)=bvar_nss(iseed)
 394              do ij=1,nss_in(index)
 395                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 396                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 397              enddo
 398            endif
 399
 400            ifused(iif)=.true.
 401            ifused(iig)=.true.
 402            call newconf_copy(idum,dihang_in(1,1,1,index),
 403      &             svar_frag(iif,1),svar_frag(iif,2),svar_frag(iif,3))
 404
 405            do j=svar_frag(iig,2),svar_frag(iig,3)
 406              do i=1,4
 407               dihang_in(i,j,1,index)=bvar(i,j,1,svar_frag(iig,1))
 408              enddo
 409            enddo
 410
 411
 412            if(iter.lt.10) then
 413             call check_old(icheck,index)
 414             if(icheck.eq.1) then
 415               index=index-1
 416               ifused(iif)=.false.
 417               goto 84
 418             endif
 419            endif
 420
 421   811     continue
 422          enddo
 423        enddo
 424       ENDIF
 425
 426 c-----------------------------------------
 427 c N14 local_move (Maurizio) for loops in a seed
 428 c
 429       IF (n14.gt.0) THEN
 430       nlx_tot=0
 431       do iters=1,nseed
 432         i1=is(iters)
 433         nlx_seed(iters)=0
 434         do i2=1,n14frag
 435           if (lvar_frag(i2,1).eq.i1) then
 436             nlx_seed(iters)=nlx_seed(iters)+3
 437             ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2)
 438             ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3)
 439             ilx_use(nlx_seed(iters),iters)=3
 440           endif
 441         enddo
 442         nlx_use(iters)=nlx_seed(iters)
 443         nlx_tot=nlx_tot+nlx_seed(iters)
 444 cd        write (iout,*) "debug N14",iters,nlx_seed(iters)
 445       enddo
 446
 447       if (nlx_tot .ge. n14*nseed) then
 448         ntot_gen=n14*nseed
 449       else
 450         ntot_gen=(nlx_tot/nseed)*nseed
 451       endif
 452 cd      write (iout,*) "debug N14",ntot_gen,n14frag,nseed
 453
 454       ngen=0
 455       do while (ngen.lt.ntot_gen)
 456       do iters=1,nseed
 457         iseed=is(iters)
 458         if (nlx_use(iters).gt.0) then
 459           nicht_getan=.true.
 460           do while (nicht_getan)
 461             iih=iran_num(1,nlx_seed(iters))
 462             if (ilx_use(iih,iters).gt.0) then
 463               nicht_getan=.false.
 464               ilx_use(iih,iters)=ilx_use(iih,iters)-1
 465               nlx_use(iters)=nlx_use(iters)-1
 466             endif
 467           enddo
 468           ngen=ngen+1
 469           index=index+1
 470           movenx(index)=14
 471           parent(1,index)=iseed
 472           parent(2,index)=0
 473
 474           idata(1,index)=ilx_seed(1,iih,iters)
 475           idata(2,index)=ilx_seed(2,iih,iters)
 476
 477
 478            if (vdisulf) then
 479              nss_in(index)=bvar_nss(iseed)
 480              do ij=1,nss_in(index)
 481                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 482                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 483              enddo
 484            endif
 485
 486
 487           do k=1,numch
 488             do j=2,nres-1
 489               do i=1,4
 490                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
 491               enddo
 492             enddo
 493           enddo
 494
 495           if (ngen.eq.ntot_gen) goto 131
 496         endif
 497       enddo
 498       enddo
 499   131 continue
 500 cd      write (iout,*) "N14",n14," ngen/nseed",ngen/nseed,
 501 cd     &                           ngen,nseed
 502
 503       ENDIF
 504 c-----------------------------------------
 505 c N9 : shift a helix in a seed
 506 c
 507       IF (n9.gt.0) THEN
 508       nhx_tot=0
 509       do iters=1,nseed
 510         i1=is(iters)
 511         nhx_seed(iters)=0
 512         do i2=1,n8frag
 513           if (hvar_frag(i2,1).eq.i1) then
 514             nhx_seed(iters)=nhx_seed(iters)+1
 515             ihx_seed(1,nhx_seed(iters),iters)=hvar_frag(i2,2)
 516             ihx_seed(2,nhx_seed(iters),iters)=hvar_frag(i2,3)
 517             ihx_use(0,nhx_seed(iters),iters)=4
 518             do i3=1,4
 519               ihx_use(i3,nhx_seed(iters),iters)=0
 520             enddo
 521           endif
 522         enddo
 523         nhx_use(iters)=4*nhx_seed(iters)
 524         nhx_tot=nhx_tot+nhx_seed(iters)
 525 cd        write (iout,*) "debug N9",iters,nhx_seed(iters)
 526       enddo
 527
 528       if (4*nhx_tot .ge. n9*nseed) then
 529         ntot_gen=n9*nseed
 530       else
 531         ntot_gen=(4*nhx_tot/nseed)*nseed
 532       endif
 533 cd      write (iout,*) "debug N9",ntot_gen,n8frag,nseed
 534
 535       ngen=0
 536       do while (ngen.lt.ntot_gen)
 537       do iters=1,nseed
 538         iseed=is(iters)
 539         if (nhx_use(iters).gt.0) then
 540           nicht_getan=.true.
 541           do while (nicht_getan)
 542             iih=iran_num(1,nhx_seed(iters))
 543             if (ihx_use(0,iih,iters).gt.0) then
 544               iim=iran_num(1,4)
 545               do while (ihx_use(iim,iih,iters).eq.1)
 546 cd                write (iout,*) iim,
 547 cd     &                ihx_use(0,iih,iters),ihx_use(iim,iih,iters)
 548                 iim=iran_num(1,4)
 549               enddo
 550               nicht_getan=.false.
 551               ihx_use(iim,iih,iters)=1
 552               ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1
 553               nhx_use(iters)=nhx_use(iters)-1
 554             endif
 555           enddo
 556           ngen=ngen+1
 557           index=index+1
 558           movenx(index)=9
 559           parent(1,index)=iseed
 560           parent(2,index)=0
 561
 562            if (vdisulf) then
 563              nss_in(index)=bvar_nss(iseed)
 564              do ij=1,nss_in(index)
 565                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 566                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 567              enddo
 568            endif
 569
 570           do k=1,numch
 571             do j=2,nres-1
 572               do i=1,4
 573                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
 574               enddo
 575             enddo
 576           enddo
 577
 578           jstart=max(nnt,ihx_seed(1,iih,iters)+1)
 579           jend=min(nct,ihx_seed(2,iih,iters))
 580 cd          write (iout,*) "debug N9",iters,iih,jstart,jend
 581           if (iim.eq.1) then
 582             ishift=-2
 583           else if (iim.eq.2) then
 584             ishift=-1
 585           else if (iim.eq.3) then
 586             ishift=1
 587           else if (iim.eq.4) then
 588             ishift=2
 589           else
 590             write (iout,*) 'CHUJ NASTAPIL: iim=',iim
 591             call mpi_abort(mpi_comm_world,ierror,ierrcode)
 592           endif
 593           do j=jstart,jend
 594             if (itype(j).eq.10) then
 595               iang=2
 596             else
 597               iang=4
 598             endif
 599             do i=1,iang
 600               if (j+ishift.ge.nnt.and.j+ishift.le.nct)
 601      &          dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed)
 602             enddo
 603           enddo
 604           if (ishift.gt.0) then
 605            do j=0,ishift-1
 606             if (itype(jend+j).eq.10) then
 607               iang=2
 608             else
 609               iang=4
 610             endif
 611             do i=1,iang
 612               if (jend+j.ge.nnt.and.jend+j.le.nct)
 613      &          dihang_in(i,jstart+j,1,index)=bvar(i,jend+j,1,iseed)
 614             enddo
 615            enddo
 616           else
 617            do j=0,-ishift-1
 618             if (itype(jstart+j).eq.10) then
 619               iang=2
 620             else
 621               iang=4
 622             endif
 623             do i=1,iang
 624               if (jend+j.ge.nnt.and.jend+j.le.nct)
 625      &          dihang_in(i,jend+j,1,index)=bvar(i,jstart+j,1,iseed)
 626             enddo
 627            enddo
 628           endif
 629           if (ngen.eq.ntot_gen) goto 133
 630         endif
 631       enddo
 632       enddo
 633   133 continue
 634 cd      write (iout,*) "N9",n9," ngen/nseed",ngen/nseed,
 635 cd     &                           ngen,nseed
 636
 637       ENDIF
 638 c-----------------------------------------
 639 c N8 : copy a helix from bank to seed
 640 c
 641       if (n8.gt.0) then
 642        if (n8frag.lt.n8) then
 643           write (iout,*) "N8: only ",n8frag,'helices'
 644           n8c=n8frag
 645        else
 646           n8c=n8
 647        endif
 648
 649        do iters=1,nseed
 650          iseed=is(iters)
 651          do i=1,mxio
 652            ifused(i)=.false.
 653          enddo
 654
 655
 656          do idummy=1,n8c
 657            iter=0
 658    94      continue
 659            iran=0
 660            iif=iran_num(1,n8frag)
 661            do while( (ifused(iif) .or. hvar_frag(iif,1).eq.iseed) .and.
 662      &                      iran.le.mxio )
 663             iif=iran_num(1,n8frag)
 664             iran=iran+1
 665            enddo
 666
 667            if(iran.ge.mxio) goto 911
 668
 669            index=index+1
 670            movenx(index)=8
 671            parent(1,index)=iseed
 672            parent(2,index)=hvar_frag(iif,1)
 673
 674
 675            if (vdisulf) then
 676              nss_in(index)=bvar_nss(iseed)
 677              do ij=1,nss_in(index)
 678                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 679                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 680              enddo
 681            endif
 682
 683            ifused(iif)=.true.
 684            if (hvar_frag(iif,3)-hvar_frag(iif,2).le.6) then
 685              call newconf_copy(idum,dihang_in(1,1,1,index),
 686      &             hvar_frag(iif,1),hvar_frag(iif,2),hvar_frag(iif,3))
 687            else
 688               ih_start=iran_num(hvar_frag(iif,2),hvar_frag(iif,3)-6)
 689               ih_end=iran_num(ih_start,hvar_frag(iif,3))
 690              call newconf_copy(idum,dihang_in(1,1,1,index),
 691      &             hvar_frag(iif,1),ih_start,ih_end)
 692            endif
 693            iter=iter+1
 694            if(iter.lt.10) then
 695             call check_old(icheck,index)
 696             if(icheck.eq.1) then
 697               index=index-1
 698               ifused(iif)=.false.
 699               goto 94
 700             endif
 701            endif
 702
 703
 704   911     continue
 705
 706          enddo
 707        enddo
 708
 709       endif
 710
 711 c-----------------------------------------
 712 c N7 : copy nonlocal beta fragment from bank to seed
 713 c
 714       if (n7.gt.0) then
 715        if (n7frag.lt.n7) then
 716           write (iout,*) "N7: only ",n7frag,'nonlocal fragments'
 717           n7c=n7frag
 718        else
 719           n7c=n7
 720        endif
 721
 722        do i=1,maxres
 723          do j=1,mxio2
 724             iff_in(i,j)=0
 725          enddo
 726        enddo
 727        index2=0
 728        do i=1,mxio
 729          isend2(i)=0
 730        enddo
 731
 732        do iters=1,nseed
 733          iseed=is(iters)
 734          do i=1,mxio
 735            ifused(i)=.false.
 736          enddo
 737
 738          do idummy=1,n7c
 739            iran=0
 740            iif=iran_num(1,n7frag)
 741            do while( (ifused(iif) .or. bvar_frag(iif,1).eq.iseed) .and.
 742      &                      iran.le.mxio )
 743             iif=iran_num(1,n7frag)
 744             iran=iran+1
 745            enddo
 746
 747 cd       write (*,'(3i5,l,4i5)'),iters,idummy,iif,ifused(iif),
 748 cd     &                    bvar_frag(iif,1),iseed,iran,index2
 749
 750            if(iran.ge.mxio) goto 999
 751            if(index2.ge.mxio2) goto 999
 752
 753            index=index+1
 754            movenx(index)=7
 755            parent(1,index)=iseed
 756            parent(2,index)=bvar_frag(iif,1)
 757            index2=index2+1
 758            isend2(index)=index2
 759            ifused(iif)=.true.
 760
 761            if (vdisulf) then
 762              nss_in(index)=bvar_nss(iseed)
 763              do ij=1,nss_in(index)
 764                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 765                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 766              enddo
 767            endif
 768
 769            do k=1,numch
 770             do j=2,nres-1
 771              do i=1,4
 772               dihang_in2(i,j,k,index2)=bvar(i,j,k,bvar_frag(iif,1))
 773              enddo
 774             enddo
 775            enddo
 776
 777            if (bvar_frag(iif,2).eq.4) then
 778              do i=bvar_frag(iif,3),bvar_frag(iif,4)
 779                iff_in(i,index2)=1
 780              enddo
 781              if (bvar_frag(iif,5).lt.bvar_frag(iif,6)) then
 782 cd               print *,'###',bvar_frag(iif,3),bvar_frag(iif,4),
 783 cd     &                 bvar_frag(iif,5),bvar_frag(iif,6)
 784                do i=bvar_frag(iif,5),bvar_frag(iif,6)
 785                  iff_in(i,index2)=1
 786                enddo
 787              else
 788 cd               print *,'###',bvar_frag(iif,3),bvar_frag(iif,4),
 789 cd     &                 bvar_frag(iif,6),bvar_frag(iif,5)
 790                do i=bvar_frag(iif,6),bvar_frag(iif,5)
 791                  iff_in(i,index2)=1
 792                enddo
 793              endif
 794            endif
 795
 796            do k=1,numch
 797             do j=2,nres-1
 798              do i=1,4
 799               dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
 800              enddo
 801             enddo
 802            enddo
 803
 804
 805   999     continue
 806
 807          enddo
 808        enddo
 809
 810       endif
 811 c-----------------------------------------------
 812 c N6 : copy random continues fragment from bank to seed
 813 c
 814       do iters=1,nseed
 815        iseed=is(iters)
 816        do idummy=1,n6
 817         isize=(is2-is1+1)*ran1(idum)+is1
 818         index=index+1
 819         movenx(index)=6
 820
 821
 822            if (vdisulf) then
 823              nss_in(index)=bvar_nss(iseed)
 824              do ij=1,nss_in(index)
 825                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 826                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 827              enddo
 828            endif
 829
 830         iter=0
 831   104   continue
 832         if(icycle.le.0) then
 833          i1=nconf*  ran1(idum)+1
 834          i1=nbank-nconf+i1
 835         else
 836          i1=nbank*  ran1(idum)+1
 837         endif
 838         if(i1.eq.iseed) goto 104
 839         iter=iter+1
 840         call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
 841         parent(1,index)=iseed
 842         parent(2,index)=i1
 843         if(iter.lt.10) then
 844          call check_old(icheck,index)
 845          if(icheck.eq.1) goto 104
 846         endif
 847        enddo
 848       enddo
 849 c-----------------------------------------
 850       if (n3.gt.0.or.n4.gt.0) call gen_hairpin
 851       nconf_harp=0
 852       do iters=1,nseed
 853         if (nharp_seed(iters).gt.0) nconf_harp=nconf_harp+1
 854       enddo
 855 c-----------------------------------------
 856 c N3 : copy hairpin from bank to seed
 857 c
 858       do iters=1,nseed
 859        iseed=is(iters)
 860        nsucc=0
 861        nacc=0
 862        do idummy=1,n3
 863         index=index+1
 864         iter=0
 865   124   continue
 866         if(icycle.le.0) then
 867          i1=nconf*  ran1(idum)+1
 868          i1=nbank-nconf+i1
 869         else
 870          i1=nbank*  ran1(idum)+1
 871         endif
 872         if(i1.eq.iseed) goto 124
 873         do k=1,nsucc
 874           if (i1.eq.iisucc(k).and.nsucc.lt.nconf_harp-1) goto 124
 875         enddo
 876         nsucc=nsucc+1
 877         iisucc(nsucc)=i1
 878         iter=iter+1
 879         call newconf_residue_hairpin(idum,dihang_in(1,1,1,index),
 880      &     i1,fail)
 881         if (fail) then
 882           if (icycle.le.0 .and. nsucc.eq.nconf .or.
 883      &        icycle.gt.0 .and. nsucc.eq.nbank)  then
 884             index=index-1
 885             goto 125
 886           else
 887             goto 124
 888           endif
 889         endif
 890         if(iter.lt.10) then
 891          call check_old(icheck,index)
 892          if(icheck.eq.1) goto 124
 893         endif
 894         movenx(index)=3
 895         parent(1,index)=iseed
 896         parent(2,index)=i1
 897
 898
 899            if (vdisulf) then
 900              nss_in(index)=bvar_nss(iseed)
 901              do ij=1,nss_in(index)
 902                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 903                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 904              enddo
 905            endif
 906
 907         nacc=nacc+1
 908        enddo
 909 c if not enough hairpins, supplement with windows
 910   125  continue
 911 cdd       if (n3.ne.0) write (iout,*) "N3",n3," nsucc",nsucc," nacc",nacc
 912        do idummy=nacc+1,n3
 913         isize=(is2-is1+1)*ran1(idum)+is1
 914         index=index+1
 915         movenx(index)=6
 916         parent(1,index)=iseed
 917         parent(2,index)=i1
 918
 919
 920            if (vdisulf) then
 921              nss_in(index)=bvar_nss(iseed)
 922              do ij=1,nss_in(index)
 923                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 924                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 925              enddo
 926            endif
 927
 928         iter=0
 929   114   continue
 930         if(icycle.le.0) then
 931          i1=nconf*  ran1(idum)+1
 932          i1=nbank-nconf+i1
 933         else
 934          i1=nbank*  ran1(idum)+1
 935         endif
 936         if(i1.eq.iseed) goto 114
 937         iter=iter+1
 938         call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
 939         if(iter.lt.10) then
 940          call check_old(icheck,index)
 941          if(icheck.eq.1) goto 114
 942         endif
 943        enddo
 944       enddo
 945 c-----------------------------------------
 946 c N4 : shift a turn in hairpin in seed
 947 c
 948       IF (N4.GT.0) THEN
 949       if (4*nharp_tot .ge. n4*nseed) then
 950         ntot_gen=n4*nseed
 951       else
 952         ntot_gen=(4*nharp_tot/nseed)*nseed
 953       endif
 954       ngen=0
 955       do while (ngen.lt.ntot_gen)
 956       do iters=1,nseed
 957         iseed=is(iters)
 958 c        write (iout,*) 'iters',iters,' iseed',iseed,' nharp_seed',
 959 c     &     nharp_seed(iters),' nharp_use',nharp_use(iters),
 960 c     &     ' ntot_gen',ntot_gen
 961 c        write (iout,*) 'iharp_use(0)',
 962 c     &     (iharp_use(0,k,iters),k=1,nharp_seed(iters))
 963         if (nharp_use(iters).gt.0) then
 964           nicht_getan=.true.
 965           do while (nicht_getan)
 966             iih=iran_num(1,nharp_seed(iters))
 967 c            write (iout,*) 'iih',iih,' iharp_use',
 968 c     &            (iharp_use(k,iih,iters),k=1,4)
 969             if (iharp_use(0,iih,iters).gt.0) then
 970               nicht_getan1=.true.
 971               do while (nicht_getan1)
 972                 iim=iran_num(1,4)
 973                 nicht_getan1=iharp_use(iim,iih,iters).eq.1
 974               enddo
 975               nicht_getan=.false.
 976               iharp_use(iim,iih,iters)=1
 977               iharp_use(0,iih,iters)=iharp_use(0,iih,iters)-1
 978               nharp_use(iters)=nharp_use(iters)-1
 979 cdd              write (iout,'(a16,i3,a5,i2,a10,2i4)')
 980 cdd     &           'N4 selected hairpin',iih,' move',iim,' iharp_seed',
 981 cdd     &            iharp_seed(1,iih,iters),iharp_seed(2,iih,iters)
 982             endif
 983           enddo
 984           ngen=ngen+1
 985           index=index+1
 986           movenx(index)=4
 987           parent(1,index)=iseed
 988           parent(2,index)=0
 989
 990
 991            if (vdisulf) then
 992              nss_in(index)=bvar_nss(iseed)
 993              do ij=1,nss_in(index)
 994                iss_in(ij,index)=bvar_ss(1,ij,iseed)
 995                jss_in(ij,index)=bvar_ss(2,ij,iseed)
 996              enddo
 997            endif
 998
 999           do k=1,numch
1000             do j=2,nres-1
1001               do i=1,4
1002                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1003               enddo
1004             enddo
1005           enddo
1006           jstart=iharp_seed(1,iih,iters)+1
1007           jend=iharp_seed(2,iih,iters)
1008           if (iim.eq.1) then
1009             ishift=-2
1010           else if (iim.eq.2) then
1011             ishift=-1
1012           else if (iim.eq.3) then
1013             ishift=1
1014           else if (iim.eq.4) then
1015             ishift=2
1016           else
1017             write (iout,*) 'CHUJ NASTAPIL: iim=',iim
1018             call mpi_abort(mpi_comm_world,ierror,ierrcode)
1019           endif
1020 c          write (iout,*) 'jstart',jstart,' jend',jend,' ishift',ishift
1021 c          write (iout,*) 'Before turn shift'
1022 c          do j=2,nres-1
1023 c            theta(j+1)=dihang_in(1,j,1,index)
1024 c            phi(j+2)=dihang_in(2,j,1,index)
1025 c            alph(j)=dihang_in(3,j,1,index)
1026 c            omeg(j)=dihang_in(4,j,1,index)
1027 c          enddo
1028 c          call intout
1029           do j=jstart,jend
1030             if (itype(j).eq.10) then
1031               iang=2
1032             else
1033               iang=4
1034             endif
1035             do i=1,iang
1036               if (j+ishift.ge.nnt.and.j+ishift.le.nct)
1037      &          dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed)
1038             enddo
1039           enddo
1040 c          write (iout,*) 'After turn shift'
1041 c          do j=2,nres-1
1042 c            theta(j+1)=dihang_in(1,j,1,index)
1043 c            phi(j+2)=dihang_in(2,j,1,index)
1044 c            alph(j)=dihang_in(3,j,1,index)
1045 c            omeg(j)=dihang_in(4,j,1,index)
1046 c          enddo
1047 c          call intout
1048           if (ngen.eq.ntot_gen) goto 135
1049         endif
1050       enddo
1051       enddo
1052 c if not enough hairpins, supplement with windows
1053 c      write (iout,*) 'end of enddo'
1054   135 continue
1055 cdd      write (iout,*) "N4",n4," ngen/nseed",ngen/nseed,
1056 cdd     &                           ngen,nseed
1057       do iters=1,nseed
1058         iseed=is(iters)
1059         do idummy=ngen/nseed+1,n4
1060           isize=(is2-is1+1)*ran1(idum)+is1
1061           index=index+1
1062           movenx(index)=6
1063
1064            if (vdisulf) then
1065              nss_in(index)=bvar_nss(iseed)
1066              do ij=1,nss_in(index)
1067                iss_in(ij,index)=bvar_ss(1,ij,iseed)
1068                jss_in(ij,index)=bvar_ss(2,ij,iseed)
1069              enddo
1070            endif
1071
1072
1073           iter=0
1074   134     continue
1075           if(icycle.le.0) then
1076           i1=nconf*  ran1(idum)+1
1077           i1=nbank-nconf+i1
1078           else
1079             i1=nbank*  ran1(idum)+1
1080           endif
1081           if(i1.eq.iseed) goto 134
1082             iter=iter+1
1083             call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
1084             parent(1,index)=iseed
1085             parent(2,index)=i1
1086             if(iter.lt.10) then
1087               call check_old(icheck,index)
1088             if(icheck.eq.1) goto 134
1089           endif
1090         enddo
1091       enddo
1092       ENDIF
1093 c-----------------------------------------
1094 c N5 : copy one residue from bank to seed (normally switched off - use N1)
1095 c
1096       do iters=1,nseed
1097        iseed=is(iters)
1098        isize=1
1099        do i=1,n5
1100         index=index+1
1101         movenx(index)=5
1102
1103            if (vdisulf) then
1104              nss_in(index)=bvar_nss(iseed)
1105              do ij=1,nss_in(index)
1106                iss_in(ij,index)=bvar_ss(1,ij,iseed)
1107                jss_in(ij,index)=bvar_ss(2,ij,iseed)
1108              enddo
1109            endif
1110
1111
1112         iter=0
1113   105   continue
1114         if(icycle.le.0) then
1115          i1=nconf*  ran1(idum)+1
1116          i1=nbank-nconf+i1
1117         else
1118          i1=nbank*  ran1(idum)+1
1119         endif
1120         if(i1.eq.iseed) goto 105
1121         iter=iter+1
1122         call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize)
1123         parent(1,index)=iseed
1124         parent(2,index)=i1
1125         if(iter.lt.10) then
1126          call check_old(icheck,index)
1127          if(icheck.eq.1) goto 105
1128         endif
1129        enddo
1130       enddo
1131 c-----------------------------------------
1132 c N2 : copy backbone of one residue from bank or first bank to seed
1133 c (normally switched off - use N1)
1134 c
1135       do iters=1,nseed
1136        iseed=is(iters)
1137        do i=n2,1,-1
1138         if(icycle.le.0.and.iuse.gt.nconf-irr) then
1139          iseed=ran1(idum)*nconf+1
1140          iseed=nbank-nconf+iseed
1141         endif
1142         index=index+1
1143         movenx(index)=2
1144
1145         if (vdisulf) then
1146              nss_in(index)=bvar_nss(iseed)
1147              do ij=1,nss_in(index)
1148                iss_in(ij,index)=bvar_ss(1,ij,iseed)
1149                jss_in(ij,index)=bvar_ss(2,ij,iseed)
1150              enddo
1151         endif
1152
1153         iter=0
1154   102   i1=  ran1(idum)*nbank+1
1155         if(i1.eq.iseed) goto 102
1156         iter=iter+1
1157         if(icycle.le.0.and.iuse.gt.nconf-irr) then
1158          nran=mod(i-1,nran0)+3
1159          call newconf1arr(idum,dihang_in(1,1,1,index),nran,i1)
1160          parent(1,index)=-iseed
1161          parent(2,index)=-i1
1162         else if(icycle.le.0.and.iters.le.iuse) then
1163          nran=mod(i-1,nran0)+1
1164          call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1)
1165          parent(1,index)=iseed
1166          parent(2,index)=-i1
1167         else
1168          nran=mod(i-1,nran1)+1
1169          if(ran1(idum).lt.0.5) then
1170           call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1)
1171           parent(1,index)=iseed
1172           parent(2,index)=-i1
1173          else
1174           call newconf1abb(idum,dihang_in(1,1,1,index),nran,i1)
1175           parent(1,index)=iseed
1176           parent(2,index)=i1
1177          endif
1178         endif
1179         if(iter.lt.10) then
1180          call check_old(icheck,index)
1181          if(icheck.eq.1) goto 102
1182         endif
1183        enddo
1184       enddo
1185 c-----------------------------------------
1186 c N1 : copy backbone or sidechain of one residue from bank or
1187 c      first bank to seed
1188 c
1189       do iters=1,nseed
1190        iseed=is(iters)
1191        do i=n1,1,-1
1192         if(icycle.le.0.and.iuse.gt.nconf-irr) then
1193          iseed=ran1(idum)*nconf+1
1194          iseed=nbank-nconf+iseed
1195         endif
1196         index=index+1
1197         movenx(index)=1
1198
1199         if (vdisulf) then
1200              nss_in(index)=bvar_nss(iseed)
1201              do ij=1,nss_in(index)
1202                iss_in(ij,index)=bvar_ss(1,ij,iseed)
1203                jss_in(ij,index)=bvar_ss(2,ij,iseed)
1204              enddo
1205         endif
1206
1207         iter=0
1208   101   i1=  ran1(idum)*nbank+1
1209
1210         if(i1.eq.iseed) goto 101
1211         iter=iter+1
1212         if(icycle.le.0.and.iuse.gt.nconf-irr) then
1213          nran=mod(i-1,nran0)+3
1214          call newconf1rr(idum,dihang_in(1,1,1,index),nran,i1)
1215          parent(1,index)=-iseed
1216          parent(2,index)=-i1
1217         else if(icycle.le.0.and.iters.le.iuse) then
1218          nran=mod(i-1,nran0)+1
1219          call newconf1br(idum,dihang_in(1,1,1,index),nran,i1)
1220          parent(1,index)=iseed
1221          parent(2,index)=-i1
1222         else
1223          nran=mod(i-1,nran1)+1
1224          if(ran1(idum).lt.0.5) then
1225           call newconf1br(idum,dihang_in(1,1,1,index),nran,i1)
1226           parent(1,index)=iseed
1227           parent(2,index)=-i1
1228          else
1229           call newconf1bb(idum,dihang_in(1,1,1,index),nran,i1)
1230           parent(1,index)=iseed
1231           parent(2,index)=i1
1232          endif
1233         endif
1234         if(iter.lt.10) then
1235          call check_old(icheck,index)
1236          if(icheck.eq.1) goto 101
1237         endif
1238        enddo
1239       enddo
1240 c-----------------------------------------
1241 c N0 just all seeds
1242 c
1243       IF (n0.gt.0) THEN
1244       do iters=1,nseed
1245        iseed=is(iters)
1246        index=index+1
1247        movenx(index)=0
1248        parent(1,index)=iseed
1249        parent(2,index)=0
1250
1251        if (vdisulf) then
1252              nss_in(index)=bvar_nss(iseed)
1253              do ij=1,nss_in(index)
1254                iss_in(ij,index)=bvar_ss(1,ij,iseed)
1255                jss_in(ij,index)=bvar_ss(2,ij,iseed)
1256              enddo
1257        endif
1258
1259        do k=1,numch
1260         do j=2,nres-1
1261          do i=1,4
1262           dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1263          enddo
1264         enddo
1265        enddo
1266       enddo
1267       ENDIF
1268 c-----------------------------------------
1269       if (vdisulf) then
1270       do iters=1,nseed
1271        iseed=is(iters)
1272
1273         do k=1,numch
1274           do j=2,nres-1
1275             theta(j+1)=bvar(1,j,k,iseed)
1276             phi(j+2)=bvar(2,j,k,iseed)
1277             alph(j)=bvar(3,j,k,iseed)
1278             omeg(j)=bvar(4,j,k,iseed)
1279           enddo
1280         enddo
1281         call chainbuild
1282
1283 cd       write(iout,*) 'makevar DYNSS',iseed,'#',bvar_ns(iseed),
1284 cd     &     (bvar_s(k,iseed),k=1,bvar_ns(iseed)),
1285 cd     &     bvar_nss(iseed),
1286 cd     &     (bvar_ss(1,k,iseed)-nres,'-',
1287 cd     &      bvar_ss(2,k,iseed)-nres,k=1,bvar_nss(iseed))
1288
1289        do i1=1,bvar_ns(iseed)
1290 c
1291 c N10 fussion of free halfcysteines in seed
1292 c      first select CYS with distance < 7A
1293 c
1294          do j1=i1+1,bvar_ns(iseed)
1295            if (dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres)
1296      &         .lt.7.0.and.
1297      &         iabs(bvar_s(i1,iseed)-bvar_s(j1,iseed)).gt.3) then
1298
1299              index=index+1
1300              movenx(index)=10
1301              parent(1,index)=iseed
1302              parent(2,index)=0
1303              do ij=1,bvar_nss(iseed)
1304                iss_in(ij,index)=bvar_ss(1,ij,iseed)
1305                jss_in(ij,index)=bvar_ss(2,ij,iseed)
1306              enddo
1307              ij=bvar_nss(iseed)+1
1308              nss_in(index)=ij
1309              iss_in(ij,index)=bvar_s(i1,iseed)+nres
1310              jss_in(ij,index)=bvar_s(j1,iseed)+nres
1311
1312 cd             write(iout,*) 'makevar NSS0',index,
1313 cd     &   dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres),
1314 cd     &   nss_in(index),iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres
1315
1316              do k=1,numch
1317               do j=2,nres-1
1318                do i=1,4
1319                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1320                enddo
1321               enddo
1322              enddo
1323
1324            endif
1325          enddo
1326 c
1327 c N11 type I transdisulfidation
1328 c
1329          do j1=1,bvar_nss(iseed)
1330            if (dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed))
1331      &         .lt.7.0.and.
1332      &         iabs(bvar_s(i1,iseed)-(bvar_ss(1,j1,iseed)-nres))
1333      &         .gt.3) then
1334
1335              index=index+1
1336              movenx(index)=11
1337              parent(1,index)=iseed
1338              parent(2,index)=0
1339              do ij=1,bvar_nss(iseed)
1340                if (ij.ne.j1) then
1341                 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1342                 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1343                endif
1344              enddo
1345              nss_in(index)=bvar_nss(iseed)
1346              iss_in(j1,index)=bvar_s(i1,iseed)+nres
1347              jss_in(j1,index)=bvar_ss(1,j1,iseed)
1348              if (iss_in(j1,index).gt.jss_in(j1,index)) then
1349                iss_in(j1,index)=bvar_ss(1,j1,iseed)
1350                jss_in(j1,index)=bvar_s(i1,iseed)+nres
1351              endif
1352
1353 cd             write(iout,*) 'makevar NSS1 #1',index,
1354 cd     &       bvar_s(i1,iseed),bvar_ss(1,j1,iseed)-nres,
1355 cd     &       dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)),
1356 cd     &       (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
1357 cd     &       ij=1,nss_in(index))
1358
1359              do k=1,numch
1360               do j=2,nres-1
1361                do i=1,4
1362                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1363                enddo
1364               enddo
1365              enddo
1366            endif
1367            if (dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed))
1368      &         .lt.7.0.and.
1369      &         iabs(bvar_s(i1,iseed)-(bvar_ss(2,j1,iseed)-nres))
1370      &         .gt.3) then
1371
1372              index=index+1
1373              movenx(index)=11
1374              parent(1,index)=iseed
1375              parent(2,index)=0
1376              do ij=1,bvar_nss(iseed)
1377                if (ij.ne.j1) then
1378                 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1379                 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1380                endif
1381              enddo
1382              nss_in(index)=bvar_nss(iseed)
1383              iss_in(j1,index)=bvar_s(i1,iseed)+nres
1384              jss_in(j1,index)=bvar_ss(2,j1,iseed)
1385              if (iss_in(j1,index).gt.jss_in(j1,index)) then
1386                iss_in(j1,index)=bvar_ss(2,j1,iseed)
1387                jss_in(j1,index)=bvar_s(i1,iseed)+nres
1388              endif
1389
1390
1391 cd             write(iout,*) 'makevar NSS1 #2',index,
1392 cd     &       bvar_s(i1,iseed),bvar_ss(2,j1,iseed)-nres,
1393 cd     &       dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)),
1394 cd     &       (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
1395 cd     &       ij=1,nss_in(index))
1396
1397              do k=1,numch
1398               do j=2,nres-1
1399                do i=1,4
1400                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1401                enddo
1402               enddo
1403              enddo
1404
1405            endif
1406          enddo
1407        enddo
1408
1409 c
1410 c N12 type II transdisulfidation
1411 c
1412        do i1=1,bvar_nss(iseed)
1413          do j1=i1+1,bvar_nss(iseed)
1414             if (dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed))
1415      &          .lt.7.0.and.
1416      &          dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed))
1417      &          .lt.7.0.and.
1418      &          iabs(bvar_ss(1,i1,iseed)-bvar_ss(1,j1,iseed))
1419      &          .gt.3.and.
1420      &          iabs(bvar_ss(2,i1,iseed)-bvar_ss(2,j1,iseed))
1421      &          .gt.3) then
1422              index=index+1
1423              movenx(index)=12
1424              parent(1,index)=iseed
1425              parent(2,index)=0
1426              do ij=1,bvar_nss(iseed)
1427                if (ij.ne.i1 .and. ij.ne.j1) then
1428                 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1429                 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1430                endif
1431              enddo
1432              nss_in(index)=bvar_nss(iseed)
1433              iss_in(i1,index)=bvar_ss(1,i1,iseed)
1434              jss_in(i1,index)=bvar_ss(1,j1,iseed)
1435              if (iss_in(i1,index).gt.jss_in(i1,index)) then
1436                iss_in(i1,index)=bvar_ss(1,j1,iseed)
1437                jss_in(i1,index)=bvar_ss(1,i1,iseed)
1438              endif
1439              iss_in(j1,index)=bvar_ss(2,i1,iseed)
1440              jss_in(j1,index)=bvar_ss(2,j1,iseed)
1441              if (iss_in(j1,index).gt.jss_in(j1,index)) then
1442                iss_in(j1,index)=bvar_ss(2,j1,iseed)
1443                jss_in(j1,index)=bvar_ss(2,i1,iseed)
1444              endif
1445
1446
1447 cd             write(iout,*) 'makevar NSS2 #1',index,
1448 cd     &       bvar_ss(1,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres,
1449 cd     &       dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)),
1450 cd     &       bvar_ss(2,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres,
1451 cd     &       dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)),
1452 cd     &       (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
1453 cd     &       ij=1,nss_in(index))
1454
1455              do k=1,numch
1456               do j=2,nres-1
1457                do i=1,4
1458                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1459                enddo
1460               enddo
1461              enddo
1462
1463            endif
1464
1465             if (dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed))
1466      &          .lt.7.0.and.
1467      &          dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed))
1468      &          .lt.7.0.and.
1469      &          iabs(bvar_ss(1,i1,iseed)-bvar_ss(2,j1,iseed))
1470      &          .gt.3.and.
1471      &          iabs(bvar_ss(2,i1,iseed)-bvar_ss(1,j1,iseed))
1472      &          .gt.3) then
1473              index=index+1
1474              movenx(index)=12
1475              parent(1,index)=iseed
1476              parent(2,index)=0
1477              do ij=1,bvar_nss(iseed)
1478                if (ij.ne.i1 .and. ij.ne.j1) then
1479                 iss_in(ij,index)=bvar_ss(1,ij,iseed)
1480                 jss_in(ij,index)=bvar_ss(2,ij,iseed)
1481                endif
1482              enddo
1483              nss_in(index)=bvar_nss(iseed)
1484              iss_in(i1,index)=bvar_ss(1,i1,iseed)
1485              jss_in(i1,index)=bvar_ss(2,j1,iseed)
1486              if (iss_in(i1,index).gt.jss_in(i1,index)) then
1487                iss_in(i1,index)=bvar_ss(2,j1,iseed)
1488                jss_in(i1,index)=bvar_ss(1,i1,iseed)
1489              endif
1490              iss_in(j1,index)=bvar_ss(2,i1,iseed)
1491              jss_in(j1,index)=bvar_ss(1,j1,iseed)
1492              if (iss_in(j1,index).gt.jss_in(j1,index)) then
1493                iss_in(j1,index)=bvar_ss(1,j1,iseed)
1494                jss_in(j1,index)=bvar_ss(2,i1,iseed)
1495              endif
1496
1497
1498 cd             write(iout,*) 'makevar NSS2 #2',index,
1499 cd     &       bvar_ss(1,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres,
1500 cd     &       dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)),
1501 cd     &       bvar_ss(2,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres,
1502 cd     &       dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)),
1503 cd     &       (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
1504 cd     &       ij=1,nss_in(index))
1505
1506              do k=1,numch
1507               do j=2,nres-1
1508                do i=1,4
1509                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1510                enddo
1511               enddo
1512              enddo
1513
1514            endif
1515
1516
1517          enddo
1518        enddo
1519 c
1520 c N13 removal of disulfide bond
1521 c
1522       if (bvar_nss(iseed).gt.0) then
1523         i1=bvar_nss(iseed)*ran1(idum)+1
1524
1525              index=index+1
1526              movenx(index)=13
1527              parent(1,index)=iseed
1528              parent(2,index)=0
1529              ij=0
1530              do j1=1,bvar_nss(iseed)
1531               if (j1.ne.i1) then
1532                ij=ij+1
1533                iss_in(ij,index)=bvar_ss(1,j1,iseed)
1534                jss_in(ij,index)=bvar_ss(2,j1,iseed)
1535               endif
1536              enddo
1537              nss_in(index)=bvar_nss(iseed)-1
1538
1539 cd             write(iout,*) 'NSS3',index,i1,
1540 cd     &   bvar_ss(1,i1,iseed)-nres,'=',bvar_ss(2,i1,iseed)-nres,'#',
1541 cd     &   (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres,
1542 cd     &   ij=1,nss_in(index))
1543
1544              do k=1,numch
1545               do j=2,nres-1
1546                do i=1,4
1547                 dihang_in(i,j,k,index)=bvar(i,j,k,iseed)
1548                enddo
1549               enddo
1550              enddo
1551
1552       endif
1553
1554       enddo
1555       endif
1556 c-----------------------------------------
1557
1558
1559
1560       if(index.ne.n) write(iout,*)'make_var : ntry=',index
1561
1562       n=index
1563 cd      do ii=1,n
1564 cd        write (istat,*) "======== ii=",ii," the dihang array"
1565 cd        do i=1,nres
1566 cd       write (istat,'(i5,4f15.5)') i,(dihang_in(k,i,1,ii)*rad2deg,k=1,4)
1567 cd        enddo
1568 cd      enddo
1569       return
1570       end
1571 ccccccccccccccccccccccccccccccccccccccccccccccccc
1572 ccccccccccccccccccccccccccccccccccccccccccccccccc
1573       subroutine check_old(icheck,n)
1574       implicit real*8 (a-h,o-z)
1575       include 'DIMENSIONS'
1576       include 'COMMON.CSA'
1577       include 'COMMON.BANK'
1578       include 'COMMON.CHAIN'
1579       include 'COMMON.GEO'
1580       data ctdif /10./
1581       data ctdiff /60./
1582
1583       i1=n
1584       do i2=1,n-1
1585        diff=0.d0
1586        do m=1,numch
1587         do j=2,nres-1
1588          do i=1,4
1589           dif=rad2deg*dabs(dihang_in(i,j,m,i1)-dihang_in(i,j,m,i2))
1590           if(dif.gt.180.0) dif=360.0-dif
1591           if(dif.gt.ctdif) goto 100
1592           diff=diff+dif
1593           if(diff.gt.ctdiff) goto 100
1594          enddo
1595         enddo
1596        enddo
1597        icheck=1
1598        return
1599   100  continue
1600       enddo
1601
1602       icheck=0
1603
1604       return
1605       end
1606 ccccccccccccccccccccccccccccccccccccccccccccccccc
1607 ccccccccccccccccccccccccccccccccccccccccccccccccc
1608       subroutine newconf1rr(idum,vvar,nran,i1)
1609       implicit real*8 (a-h,o-z)
1610       include 'DIMENSIONS'
1611       include 'COMMON.IOUNITS'
1612       include 'COMMON.CSA'
1613       include 'COMMON.BANK'
1614       include 'COMMON.CHAIN'
1615       include 'COMMON.GEO'
1616       real ran1,ran2
1617       dimension vvar(mxang,maxres,mxch),iold(ntotal)
1618       ctdif=10.
1619
1620       do k=1,numch
1621        do j=2,nres-1
1622         do i=1,4
1623          vvar(i,j,k)=rvar(i,j,k,iseed)
1624         enddo
1625        enddo
1626       enddo
1627
1628       do index=1,nran
1629        iold(index) = 0
1630       enddo
1631
1632       number=ntotgr
1633
1634       iter=0
1635       do index=1,nran
1636    10  iran=  ran1(idum)*number+1
1637        if(iter.gt.number) return
1638        iter=iter+1
1639        if(iter.eq.1) goto 11
1640        do ind=1,index-1
1641         if(iran.eq.iold(ind)) goto 10
1642        enddo
1643    11  continue
1644
1645        do ind=1,ngroup(iran)
1646         i=igroup(1,ind,iran)
1647         j=igroup(2,ind,iran)
1648         k=igroup(3,ind,iran)
1649         dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
1650         if(dif.gt.180.) dif=360.-dif
1651         if(dif.gt.ctdif) goto 20
1652        enddo
1653        if(iter.gt.number) goto 20
1654        goto 10
1655    20  continue
1656        do ind=1,ngroup(iran)
1657         i=igroup(1,ind,iran)
1658         j=igroup(2,ind,iran)
1659         k=igroup(3,ind,iran)
1660         vvar(i,j,k)=rvar(i,j,k,i1)
1661        enddo
1662        iold(index)=iran
1663       enddo
1664
1665       return
1666       end
1667 ccccccccccccccccccccccccccccccccccccccccccccccccc
1668 ccccccccccccccccccccccccccccccccccccccccccccccccc
1669       subroutine newconf1br(idum,vvar,nran,i1)
1670       implicit real*8 (a-h,o-z)
1671       include 'DIMENSIONS'
1672       include 'COMMON.IOUNITS'
1673       include 'COMMON.CSA'
1674       include 'COMMON.BANK'
1675       include 'COMMON.CHAIN'
1676       include 'COMMON.GEO'
1677       include 'COMMON.TORCNSTR'
1678       include 'COMMON.CONTROL'
1679       real ran1,ran2
1680       dimension vvar(mxang,maxres,mxch),iold(ntotal)
1681       ctdif=10.
1682
1683       do k=1,numch
1684        do j=2,nres-1
1685         do i=1,4
1686          vvar(i,j,k)=bvar(i,j,k,iseed)
1687         enddo
1688        enddo
1689       enddo
1690
1691       do index=1,nran
1692        iold(index) = 0
1693       enddo
1694
1695       number=ntotgr
1696
1697       iter=0
1698       do index=1,nran
1699    10  iran=  ran1(idum)*number+1
1700        if(i2ndstr.gt.0) then
1701         rtmp=ran1(idum)
1702         if(rtmp.le.rdih_bias) then
1703          i=0
1704          do j=1,ndih_nconstr
1705           if(igroup(2,1,iran).eq.idih_nconstr(j))i=j
1706          enddo
1707          if(i.eq.0) then
1708           juhc=0
1709 4321      juhc=juhc+1
1710           iran=  ran1(idum)*number+1
1711           i=0
1712           do j=1,ndih_nconstr
1713            if(igroup(2,1,iran).eq.idih_nconstr(j))i=j
1714           enddo
1715           if(i.eq.0.or.juhc.lt.1000)goto 4321
1716           if(juhc.eq.1000) then
1717            print *, 'move 6 : failed to find unconstrained group'
1718            write(iout,*) 'move 6 : failed to find unconstrained group'
1719           endif
1720          endif
1721         endif
1722        endif
1723        if(iter.gt.number) return
1724        iter=iter+1
1725        if(iter.eq.1) goto 11
1726        do ind=1,index-1
1727         if(iran.eq.iold(ind)) goto 10
1728        enddo
1729    11  continue
1730
1731        do ind=1,ngroup(iran)
1732         i=igroup(1,ind,iran)
1733         j=igroup(2,ind,iran)
1734         k=igroup(3,ind,iran)
1735         dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
1736         if(dif.gt.180.) dif=360.-dif
1737         if(dif.gt.ctdif) goto 20
1738        enddo
1739        if(iter.gt.number) goto 20
1740        goto 10
1741    20  continue
1742        do ind=1,ngroup(iran)
1743         i=igroup(1,ind,iran)
1744         j=igroup(2,ind,iran)
1745         k=igroup(3,ind,iran)
1746         vvar(i,j,k)=rvar(i,j,k,i1)
1747        enddo
1748        iold(index)=iran
1749       enddo
1750
1751       return
1752       end
1753 ccccccccccccccccccccccccccccccccccccccccccccccccc
1754 ccccccccccccccccccccccccccccccccccccccccccccccccc
1755       subroutine newconf1bb(idum,vvar,nran,i1)
1756       implicit real*8 (a-h,o-z)
1757       include 'DIMENSIONS'
1758       include 'COMMON.IOUNITS'
1759       include 'COMMON.CSA'
1760       include 'COMMON.BANK'
1761       include 'COMMON.CHAIN'
1762       include 'COMMON.GEO'
1763       real ran1,ran2
1764       dimension vvar(mxang,maxres,mxch),iold(ntotal)
1765       ctdif=10.
1766
1767       do k=1,numch
1768        do j=2,nres-1
1769         do i=1,4
1770          vvar(i,j,k)=bvar(i,j,k,iseed)
1771         enddo
1772        enddo
1773       enddo
1774
1775       do index=1,nran
1776        iold(index) = 0
1777       enddo
1778
1779       number=ntotgr
1780
1781       iter=0
1782       do index=1,nran
1783    10  iran=  ran1(idum)*number+1
1784        if(iter.gt.number) return
1785        iter=iter+1
1786        if(iter.eq.1) goto 11
1787        do ind=1,index-1
1788         if(iran.eq.iold(ind)) goto 10
1789        enddo
1790    11  continue
1791
1792        do ind=1,ngroup(iran)
1793         i=igroup(1,ind,iran)
1794         j=igroup(2,ind,iran)
1795         k=igroup(3,ind,iran)
1796         dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
1797         if(dif.gt.180.) dif=360.-dif
1798         if(dif.gt.ctdif) goto 20
1799        enddo
1800        if(iter.gt.number) goto 20
1801        goto 10
1802    20  continue
1803        do ind=1,ngroup(iran)
1804         i=igroup(1,ind,iran)
1805         j=igroup(2,ind,iran)
1806         k=igroup(3,ind,iran)
1807         vvar(i,j,k)=bvar(i,j,k,i1)
1808        enddo
1809        iold(index)=iran
1810       enddo
1811
1812       return
1813       end
1814 ccccccccccccccccccccccccccccccccccccccccccccccccc
1815 ccccccccccccccccccccccccccccccccccccccccccccccccc
1816       subroutine newconf1arr(idum,vvar,nran,i1)
1817       implicit real*8 (a-h,o-z)
1818       include 'DIMENSIONS'
1819       include 'COMMON.IOUNITS'
1820       include 'COMMON.CSA'
1821       include 'COMMON.BANK'
1822       include 'COMMON.CHAIN'
1823       include 'COMMON.GEO'
1824       real ran1,ran2
1825       dimension vvar(mxang,maxres,mxch),iold(ntotal)
1826       ctdif=10.
1827
1828       do k=1,numch
1829        do j=2,nres-1
1830         do i=1,4
1831          vvar(i,j,k)=rvar(i,j,k,iseed)
1832         enddo
1833        enddo
1834       enddo
1835
1836       do index=1,nran
1837        iold(index) = 0
1838       enddo
1839
1840       number=nres-2
1841
1842       iter=0
1843       do index=1,nran
1844    10  iran=  ran1(idum)*number+1
1845        if(iter.gt.number) return
1846        iter=iter+1
1847        if(iter.eq.1) goto 11
1848        do ind=1,index-1
1849         if(iran.eq.iold(ind)) goto 10
1850        enddo
1851    11  continue
1852
1853        do ind=1,ngroup(iran)
1854         i=igroup(1,ind,iran)
1855         j=igroup(2,ind,iran)
1856         k=igroup(3,ind,iran)
1857         dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
1858         if(dif.gt.180.) dif=360.-dif
1859         if(dif.gt.ctdif) goto 20
1860        enddo
1861        if(iter.gt.number) goto 20
1862        goto 10
1863    20  continue
1864        do ind=1,ngroup(iran)
1865         i=igroup(1,ind,iran)
1866         j=igroup(2,ind,iran)
1867         k=igroup(3,ind,iran)
1868         vvar(i,j,k)=rvar(i,j,k,i1)
1869        enddo
1870        iold(index)=iran
1871       enddo
1872
1873       return
1874       end
1875 ccccccccccccccccccccccccccccccccccccccccccccccccc
1876 ccccccccccccccccccccccccccccccccccccccccccccccccc
1877       subroutine newconf1abr(idum,vvar,nran,i1)
1878       implicit real*8 (a-h,o-z)
1879       include 'DIMENSIONS'
1880       include 'COMMON.IOUNITS'
1881       include 'COMMON.CSA'
1882       include 'COMMON.BANK'
1883       include 'COMMON.CHAIN'
1884       include 'COMMON.GEO'
1885       include 'COMMON.TORCNSTR'
1886       include 'COMMON.CONTROL'
1887       real ran1,ran2
1888       dimension vvar(mxang,maxres,mxch),iold(ntotal)
1889       ctdif=10.
1890
1891       do k=1,numch
1892        do j=2,nres-1
1893         do i=1,4
1894          vvar(i,j,k)=bvar(i,j,k,iseed)
1895         enddo
1896        enddo
1897       enddo
1898
1899       do index=1,nran
1900        iold(index) = 0
1901       enddo
1902
1903       number=nres-2
1904
1905       iter=0
1906       do index=1,nran
1907    10  iran=  ran1(idum)*number+1
1908       if(i2ndstr.gt.0) then
1909        rtmp=ran1(idum)
1910        if(rtmp.le.rdih_bias) then
1911         iran=ran1(idum)*ndih_nconstr+1
1912         iran=idih_nconstr(iran)
1913        endif
1914       endif
1915        if(iter.gt.number) return
1916        iter=iter+1
1917        if(iter.eq.1) goto 11
1918        do ind=1,index-1
1919         if(iran.eq.iold(ind)) goto 10
1920        enddo
1921    11  continue
1922
1923        do ind=1,ngroup(iran)
1924         i=igroup(1,ind,iran)
1925         j=igroup(2,ind,iran)
1926         k=igroup(3,ind,iran)
1927         dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1))
1928         if(dif.gt.180.) dif=360.-dif
1929         if(dif.gt.ctdif) goto 20
1930        enddo
1931        if(iter.gt.number) goto 20
1932        goto 10
1933    20  continue
1934        do ind=1,ngroup(iran)
1935         i=igroup(1,ind,iran)
1936         j=igroup(2,ind,iran)
1937         k=igroup(3,ind,iran)
1938         vvar(i,j,k)=rvar(i,j,k,i1)
1939        enddo
1940        iold(index)=iran
1941       enddo
1942
1943       return
1944       end
1945 ccccccccccccccccccccccccccccccccccccccccccccccccc
1946 ccccccccccccccccccccccccccccccccccccccccccccccccc
1947       subroutine newconf1abb(idum,vvar,nran,i1)
1948       implicit real*8 (a-h,o-z)
1949       include 'DIMENSIONS'
1950       include 'COMMON.IOUNITS'
1951       include 'COMMON.CSA'
1952       include 'COMMON.BANK'
1953       include 'COMMON.CHAIN'
1954       include 'COMMON.GEO'
1955       include 'COMMON.TORCNSTR'
1956       include 'COMMON.CONTROL'
1957       real ran1,ran2
1958       dimension vvar(mxang,maxres,mxch),iold(ntotal)
1959       ctdif=10.
1960
1961       do k=1,numch
1962        do j=2,nres-1
1963         do i=1,4
1964          vvar(i,j,k)=bvar(i,j,k,iseed)
1965         enddo
1966        enddo
1967       enddo
1968
1969       do index=1,nran
1970        iold(index) = 0
1971       enddo
1972
1973       number=nres-2
1974
1975       iter=0
1976       do index=1,nran
1977    10  iran=  ran1(idum)*number+1
1978       if(i2ndstr.gt.0) then
1979        rtmp=ran1(idum)
1980        if(rtmp.le.rdih_bias) then
1981         iran=ran1(idum)*ndih_nconstr+1
1982         iran=idih_nconstr(iran)
1983        endif
1984       endif
1985        if(iter.gt.number) return
1986        iter=iter+1
1987        if(iter.eq.1) goto 11
1988        do ind=1,index-1
1989         if(iran.eq.iold(ind)) goto 10
1990        enddo
1991    11  continue
1992
1993        do ind=1,ngroup(iran)
1994         i=igroup(1,ind,iran)
1995         j=igroup(2,ind,iran)
1996         k=igroup(3,ind,iran)
1997         dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
1998         if(dif.gt.180.) dif=360.-dif
1999         if(dif.gt.ctdif) goto 20
2000        enddo
2001        if(iter.gt.number) goto 20
2002        goto 10
2003    20  continue
2004        do ind=1,ngroup(iran)
2005         i=igroup(1,ind,iran)
2006         j=igroup(2,ind,iran)
2007         k=igroup(3,ind,iran)
2008         vvar(i,j,k)=bvar(i,j,k,i1)
2009        enddo
2010        iold(index)=iran
2011       enddo
2012
2013       return
2014       end
2015 ccccccccccccccccccccccccccccccccccccccccccccccccc
2016 ccccccccccccccccccccccccccccccccccccccccccccccccc
2017       subroutine newconf_residue(idum,vvar,i1,isize)
2018       implicit real*8 (a-h,o-z)
2019       include 'DIMENSIONS'
2020       include 'COMMON.IOUNITS'
2021       include 'COMMON.CSA'
2022       include 'COMMON.BANK'
2023       include 'COMMON.CHAIN'
2024       include 'COMMON.GEO'
2025       include 'COMMON.TORCNSTR'
2026       include 'COMMON.CONTROL'
2027       real ran1,ran2
2028       dimension vvar(mxang,maxres,mxch),iold(ntotal)
2029       ctdif=10.
2030
2031       if (iseed.gt.mxio .or. iseed.lt.1) then
2032         write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
2033         call mpi_abort(mpi_comm_world,ierror,ierrcode)
2034       endif
2035       do k=1,numch
2036        do j=2,nres-1
2037         do i=1,4
2038          vvar(i,j,k)=bvar(i,j,k,iseed)
2039         enddo
2040        enddo
2041       enddo
2042
2043
2044       k=1
2045       number=nres+isize-2
2046       iter=1
2047    10 iran=  ran1(idum)*number+1
2048       if(i2ndstr.gt.0) then
2049        rtmp=ran1(idum)
2050        if(rtmp.le.rdih_bias) then
2051         iran=ran1(idum)*ndih_nconstr+1
2052         iran=idih_nconstr(iran)
2053        endif
2054       endif
2055       istart=iran-isize+1
2056       iend=iran
2057       if(istart.lt.2) istart=2
2058       if(iend.gt.nres-1) iend=nres-1
2059
2060       if(iter.eq.1) goto 11
2061       do ind=1,iter-1
2062        if(iran.eq.iold(ind)) goto 10
2063       enddo
2064    11 continue
2065
2066       do j=istart,iend
2067        do i=1,4
2068          dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
2069          if(dif.gt.180.) dif=360.-dif
2070          if(dif.gt.ctdif) goto 20
2071        enddo
2072       enddo
2073       iold(iter)=iran
2074       iter=iter+1
2075       if(iter.gt.number) goto 20
2076       goto 10
2077
2078    20 continue
2079       do j=istart,iend
2080        do i=1,4
2081         vvar(i,j,k)=bvar(i,j,k,i1)
2082        enddo
2083       enddo
2084
2085       return
2086       end
2087
2088 ccccccccccccccccccccccccccccccccccccccccccccccccc
2089 ccccccccccccccccccccccccccccccccccccccccccccccccc
2090       subroutine newconf_copy(idum,vvar,i1,istart,iend)
2091       implicit real*8 (a-h,o-z)
2092       include 'DIMENSIONS'
2093       include 'COMMON.IOUNITS'
2094       include 'COMMON.CSA'
2095       include 'COMMON.BANK'
2096       include 'COMMON.CHAIN'
2097       include 'COMMON.GEO'
2098       include 'COMMON.TORCNSTR'
2099       include 'COMMON.CONTROL'
2100       real ran1,ran2
2101       dimension vvar(mxang,maxres,mxch),iold(ntotal)
2102       ctdif=10.
2103
2104       if (iseed.gt.mxio .or. iseed.lt.1) then
2105         write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
2106         call mpi_abort(mpi_comm_world,ierror,ierrcode)
2107       endif
2108       do k=1,numch
2109        do j=2,nres-1
2110         do i=1,4
2111          vvar(i,j,k)=bvar(i,j,k,iseed)
2112         enddo
2113        enddo
2114       enddo
2115
2116
2117       do j=istart,iend
2118        do i=1,4
2119         vvar(i,j,1)=bvar(i,j,1,i1)
2120        enddo
2121       enddo
2122
2123       return
2124       end
2125 ccccccccccccccccccccccccccccccccccccccccccccccccc
2126 ccccccccccccccccccccccccccccccccccccccccccccccccc
2127       subroutine newconf_residue_hairpin(idum,vvar,i1,fail)
2128       implicit real*8 (a-h,o-z)
2129       include 'DIMENSIONS'
2130       include 'COMMON.IOUNITS'
2131       include 'COMMON.CSA'
2132       include 'COMMON.BANK'
2133       include 'COMMON.CHAIN'
2134       include 'COMMON.GEO'
2135       include 'COMMON.VAR'
2136       real ran1,ran2
2137       dimension vvar(mxang,maxres,mxch),iold(ntotal)
2138       integer nharp,iharp(4,maxres/3),icipa(maxres/3)
2139       logical fail,not_done
2140       ctdif=10.
2141
2142       fail=.false.
2143       if (iseed.gt.mxio .or. iseed.lt.1) then
2144         write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed
2145         call mpi_abort(mpi_comm_world,ierror,ierrcode)
2146       endif
2147       do k=1,numch
2148        do j=2,nres-1
2149         do i=1,4
2150          vvar(i,j,k)=bvar(i,j,k,iseed)
2151         enddo
2152        enddo
2153       enddo
2154       do k=1,numch
2155       do j=2,nres-1
2156         theta(j+1)=bvar(1,j,k,i1)
2157         phi(j+2)=bvar(2,j,k,i1)
2158         alph(j)=bvar(3,j,k,i1)
2159         omeg(j)=bvar(4,j,k,i1)
2160       enddo
2161       enddo
2162 c      call intout
2163       call chainbuild
2164       call hairpin(.false.,nharp,iharp)
2165
2166       if (nharp.eq.0) then
2167         fail=.true.
2168         return
2169       endif
2170
2171       n_used=0
2172
2173       DO III=1,NHARP
2174
2175       not_done = .true.
2176       icount=0
2177       do while (not_done)
2178         icount=icount+1
2179         iih=iran_num(1,nharp)
2180         do k=1,n_used
2181           if (iih.eq.icipa(k)) then
2182             iih=0
2183             goto 22
2184           endif
2185         enddo
2186         not_done=.false.
2187         n_used=n_used+1
2188         icipa(n_used)=iih
2189    22   continue
2190         not_done = not_done .and. icount.le.nharp
2191       enddo
2192
2193       if (iih.eq.0) then
2194         write (iout,*) "CHUJ NASTAPIL W NEWCONF_RESIDUE_HAIRPIN!!!!"
2195         fail=.true.
2196         return
2197       endif
2198
2199       istart=iharp(1,iih)+1
2200       iend=iharp(2,iih)
2201
2202 cdd      write (iout,*) "newconf_residue_hairpin: iih",iih,
2203 cdd     &   " istart",istart," iend",iend
2204
2205       do k=1,numch
2206       do j=istart,iend
2207        do i=1,4
2208          dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1))
2209          if(dif.gt.180.) dif=360.-dif
2210          if(dif.gt.ctdif) goto 20
2211        enddo
2212       enddo
2213       enddo
2214       goto 10
2215    20 continue
2216       do k=1,numch
2217       do j=istart,iend
2218        do i=1,4
2219         vvar(i,j,k)=bvar(i,j,k,i1)
2220        enddo
2221       enddo
2222       enddo
2223 c      do j=1,numch
2224 c       do l=2,nres-1
2225 c        write (iout,'(4f8.3)') (rad2deg*vvar(i,l,j),i=1,4)
2226 c       enddo
2227 c      enddo
2228       return
2229    10 continue
2230       ENDDO
2231
2232       fail=.true.
2233
2234       return
2235       end
2236 ccccccccccccccccccccccccccccccccccccccccccccccccc
2237 ccccccccccccccccccccccccccccccccccccccccccccccccc
2238       subroutine gen_hairpin
2239       implicit real*8 (a-h,o-z)
2240       include 'DIMENSIONS'
2241       include 'COMMON.IOUNITS'
2242       include 'COMMON.CSA'
2243       include 'COMMON.BANK'
2244       include 'COMMON.CHAIN'
2245       include 'COMMON.GEO'
2246       include 'COMMON.VAR'
2247       include 'COMMON.HAIRPIN'
2248
2249 c      write (iout,*) 'Entering GEN_HAIRPIN'
2250       do iters=1,nseed
2251         i1=is(iters)
2252         do k=1,numch
2253           do j=2,nres-1
2254             theta(j+1)=bvar(1,j,k,i1)
2255             phi(j+2)=bvar(2,j,k,i1)
2256             alph(j)=bvar(3,j,k,i1)
2257             omeg(j)=bvar(4,j,k,i1)
2258           enddo
2259         enddo
2260         call chainbuild
2261         call hairpin(.false.,nharp_seed(iters),iharp_seed(1,1,iters))
2262       enddo
2263
2264       nharp_tot=0
2265       do iters=1,nseed
2266         nharp_tot=nharp_tot+nharp_seed(iters)
2267         nharp_use(iters)=4*nharp_seed(iters)
2268         do j=1,nharp_seed(iters)
2269           iharp_use(0,j,iters)=4
2270           do k=1,4
2271             iharp_use(k,j,iters)=0
2272           enddo
2273         enddo
2274       enddo
2275
2276       write (iout,*) 'GEN_HAIRPIN: nharp_tot',nharp_tot
2277 cdd      do i=1,nseed
2278 cdd        write (iout,*) 'seed',i
2279 cdd        write (iout,*) 'nharp_seed',nharp_seed(i),
2280 cdd     &     ' nharp_use',nharp_use(i)
2281 cd        write (iout,*) 'iharp_seed, iharp_use'
2282 cd        do j=1,nharp_seed(i)
2283 cd          write (iout,'(7i3)') iharp_seed(1,j,i),iharp_seed(2,j,i),
2284 cd     &      (iharp_use(k,j,i),k=0,4)
2285 cd        enddo
2286 cdd      enddo
2287       return
2288       end
2289
2290 ccccccccccccccccccccccccccccccccccccccccccccccccc
2291 ccccccccccccccccccccccccccccccccccccccccccccccccc
2292       subroutine select_frag(nn,nh,nl,ns,nb,i_csa)
2293       implicit real*8 (a-h,o-z)
2294       include 'DIMENSIONS'
2295       include 'COMMON.IOUNITS'
2296       include 'COMMON.CSA'
2297       include 'COMMON.BANK'
2298       include 'COMMON.CHAIN'
2299       include 'COMMON.GEO'
2300       include 'COMMON.VAR'
2301       include 'COMMON.HAIRPIN'
2302       include 'COMMON.DISTFIT'
2303       character*50 linia
2304       integer isec(maxres)
2305
2306
2307       nn=0
2308       nh=0
2309       nl=0
2310       ns=0
2311       nb=0
2312 cd      write (iout,*) 'Entering select_frag'
2313       do i1=1,nbank
2314         do i=1,nres
2315           isec(i)=0
2316         enddo
2317         do k=1,numch
2318           do j=2,nres-1
2319             theta(j+1)=bvar(1,j,k,i1)
2320             phi(j+2)=bvar(2,j,k,i1)
2321             alph(j)=bvar(3,j,k,i1)
2322             omeg(j)=bvar(4,j,k,i1)
2323           enddo
2324         enddo
2325         call chainbuild
2326 cd        write (iout,*) ' -- ',i1,' -- '
2327         call secondary2(.false.)
2328 c
2329 c bvar_frag nn==pair of nonlocal strands in beta sheet (loop>4)
2330 c               strands > 4 residues; used by N7 and N16
2331 c
2332         do j=1,nbfrag
2333 c
2334 Ctest 09/12/02 bfrag(2,j)-bfrag(1,j).gt.3
2335 c
2336               do i=bfrag(1,j),bfrag(2,j)
2337                 isec(i)=1
2338               enddo
2339               do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j))
2340                 isec(i)=1
2341               enddo
2342
2343            if ( (bfrag(3,j).lt.bfrag(4,j) .or.
2344      &          bfrag(4,j)-bfrag(2,j).gt.4) .and.
2345      &          bfrag(2,j)-bfrag(1,j).gt.4 ) then
2346              nn=nn+1
2347
2348
2349              if (bfrag(3,j).lt.bfrag(4,j)) then
2350                write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
2351      &                     "select",bfrag(1,j)-1,"-",bfrag(2,j)-1
2352      &                         ,",",bfrag(3,j)-1,"-",bfrag(4,j)-1
2353              else
2354                write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)')
2355      &                     "select",bfrag(1,j)-1,"-",bfrag(2,j)-1
2356      &                         ,",",bfrag(4,j)-1,"-",bfrag(3,j)-1
2357
2358              endif
2359 cd             call write_pdb(i_csa*1000+nn+nh,linia,0d0)
2360
2361              bvar_frag(nn,1)=i1
2362              bvar_frag(nn,2)=4
2363              do i=1,4
2364                bvar_frag(nn,i+2)=bfrag(i,j)
2365              enddo
2366            endif
2367         enddo
2368
2369 c
2370 c hvar_frag nh==helices; used by N8 and N9
2371 c
2372         do j=1,nhfrag
2373
2374               do i=hfrag(1,j),hfrag(2,j)
2375                 isec(i)=2
2376               enddo
2377
2378           if ( hfrag(2,j)-hfrag(1,j).gt.4 ) then
2379             nh=nh+1
2380
2381 cd            write(linia,'(a6,i3,a1,i3)')
2382 cd     &                "select",hfrag(1,j)-1,"-",hfrag(2,j)-1
2383 cd            call write_pdb(i_csa*1000+nn+nh,linia,0d0)
2384
2385             hvar_frag(nh,1)=i1
2386             hvar_frag(nh,2)=hfrag(1,j)
2387             hvar_frag(nh,3)=hfrag(2,j)
2388           endif
2389         enddo
2390
2391
2392 cv        write(iout,'(i4,1pe12.4,1x,1000i1)')
2393 cv     &         i1,bene(i1),(isec(i),i=1,nres)
2394 cv            write(linia,'(i4,1x,1000i1)')
2395 cv     &         i1,(isec(i),i=1,nres)
2396 cv            call write_pdb(i_csa*1000+i1,linia,bene(i1))
2397 c
2398 c lvar_frag nl==loops; used by N14
2399 c
2400         i=1
2401         nl1=nl
2402         do while (i.lt.nres)
2403           if (isec(i).eq.0) then
2404            nl=nl+1
2405            lvar_frag(nl,1)=i1
2406            lvar_frag(nl,2)=i
2407            i=i+1
2408            do while (isec(i).eq.0.and.i.le.nres)
2409              i=i+1
2410            enddo
2411            lvar_frag(nl,3)=i-1
2412            if (lvar_frag(nl,3)-lvar_frag(nl,2).lt.1) nl=nl-1
2413           endif
2414           i=i+1
2415         enddo
2416 cd        write(iout,'(4i5)') (i,(lvar_frag(i,ii),ii=1,3),i=nl1+1,nl)
2417
2418 c
2419 c svar_frag ns==an secondary structure element; used by N15
2420 c
2421         i=1
2422         ns1=ns
2423         do while (i.lt.nres)
2424           if (isec(i).gt.0) then
2425            ns=ns+1
2426            svar_frag(ns,1)=i1
2427            svar_frag(ns,2)=i
2428            i=i+1
2429            do while (isec(i).gt.0.and.isec(i-1).eq.isec(i)
2430      &                         .and.i.le.nres)
2431              i=i+1
2432            enddo
2433            svar_frag(ns,3)=i-1
2434            if (svar_frag(ns,3)-svar_frag(ns,2).lt.1) ns=ns-1
2435           endif
2436           if (isec(i).eq.0) i=i+1
2437         enddo
2438 cd        write(iout,'(4i5)') (i,(svar_frag(i,ii),ii=1,3),i=ns1+1,ns)
2439
2440 c
2441 c avar_frag nb==any pair of beta strands; used by N17
2442 c
2443         do j=1,nbfrag
2444              nb=nb+1
2445              avar_frag(nb,1)=i1
2446              do i=1,4
2447                avar_frag(nb,i+1)=bfrag(i,j)
2448              enddo
2449         enddo
2450
2451       enddo
2452
2453       return
2454       end