wham and cluster_wham Adam's new constr_dist multichain
[unres.git] / source / unres / src_MD-M / 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