Trying to bring files - continued
[unres.git] / source / unres / src_CSA / bank.F
1 #ifdef MPI
2 cc---------------------------------
3       subroutine refresh_bank(ntrial)
4       implicit real*8 (a-h,o-z)
5       include 'DIMENSIONS'
6       include 'mpif.h'
7       include 'COMMON.CSA'
8       include 'COMMON.BANK'
9       include 'COMMON.IOUNITS'
10       include 'COMMON.CHAIN'
11       include 'COMMON.VAR'
12       include 'COMMON.CONTROL'
13       character chacc
14       integer iaccn
15       double precision l_diff(mxio),denep
16
17       do i=0,mxmv
18         do j=1,3
19           nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
20           nstatnx(i,j)=0
21         enddo
22       enddo
23
24 c loop over all newly obtained conformations
25       do n=1,ntrial
26        chacc=' '
27        iaccn=0
28        nstatnx(movernx(n),1)=nstatnx(movernx(n),1)+1
29 cccccccccccccccccccccccccccccccccccccccccccc
30 cjlee
31        if(iref.ne.0) then
32         if(rmsn(n).gt.rmscut.or.pncn(n).lt.pnccut) goto 100
33        endif
34 cjlee
35        if(etot(n).gt.ebmax) goto 100
36 c Find the conformation closest to the conformation n in the bank
37        difmin=9.d9
38        do m=1,nbank
39         call get_diff12(dihang(1,1,1,n),bvar(1,1,1,m),l_diff(m))
40         if(l_diff(m).lt.difmin) then
41          difmin=l_diff(m)
42          idmin=m
43         endif
44        enddo
45
46        if(difmin.lt.cutdif) then
47 c n is redundant to idmin
48         if(etot(n).lt.bene(idmin)) then
49          if(etot(n).lt.bene(idmin)-0.01d0) then
50           ibank(idmin)=0
51           jbank(idmin)=0
52          endif
53          denep=bene(idmin)-etot(n)
54          call replace_bvar(idmin,n)
55 crc Update dij
56          do i1=1,nbank
57            if (i1.ne.idmin) then
58             dij(i1,idmin)=l_diff(i1)
59             dij(idmin,i1)=l_diff(i1)
60            endif
61          enddo
62          chacc='c'
63          iaccn=idmin
64          nstatnx(movernx(n),2)=nstatnx(movernx(n),2)+1
65          if(idmin.eq.ibmax) call find_max
66         endif
67        else
68 c got new conformation
69         del_ene=0.0d0
70         if(ebmax-ebmin.gt.del_ene) then
71          denep=ebmax-etot(n)
72          call replace_bvar(ibmax,n)
73 crc Update dij
74          do i1=1,nbank
75            if (i1.ne.ibmax) then
76             dij(i1,ibmax)=l_diff(i1)
77             dij(ibmax,i1)=l_diff(i1)
78            endif
79          enddo
80          chacc='f'
81          iaccn=ibmax
82          nstatnx(movernx(n),3)=nstatnx(movernx(n),3)+1
83          ibank(ibmax)=0
84          jbank(ibmax)=0
85          call find_max
86         else
87          if(del_ene.lt.0.0001) then
88           write (iout,*) 'ERROR in refresh_bank: '
89           write (iout,*) 'ebmax: ',ebmax
90           write (iout,*) 'ebmin: ',ebmin
91           write (iout,*) 'del_ene: ',del_ene
92 crc          call mpi_abort(mpi_comm_world,ierror,ierrcode)
93          endif
94 cjp nbmax is never defined so condition below is always false
95 c         if(nbank.lt.nbmax) then
96 c          nbank=nbank+1
97 c          call replace_bvar(nbank,n)
98 c          ibank(nbank)=0
99 c          jbank(nbank)=0
100 c         else
101           call replace_bvar(ibmax,n)
102           ibank(ibmax)=0
103           jbank(ibmax)=0
104           call find_max
105 c         endif
106         endif
107        endif
108 cccccccccccccccccccccccccccccccccccccccccccc
109   100 continue
110        if (iaccn.eq.0) then
111         if (iref.eq.0) then 
112          write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5)') 
113      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',
114      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9)
115         else
116       write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5
117      &       ,a5,0pf4.1,a5,f3.0)') 
118      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',
119      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
120      &    ' rms ',rmsn(n),' %NC ',pncn(n)*100
121         endif
122        else
123         if (iref.eq.0) then
124         write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,
125      &         1x,a1,i4,0pf8.1,0pf8.1)') 
126      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',
127      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
128      &    chacc,iaccn,difmin,denep
129         else
130          write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,
131      &                   0pf4.1,a5,f3.0,1x,a1,i4,0pf8.1,0pf8.1)') 
132      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',etot(n),' mv ',
133      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
134      &    ' rms ',rmsn(n),' %NC ',pncn(n)*100,
135      &     chacc,iaccn,difmin,denep
136         endif
137        endif
138       enddo
139 c end of loop over all newly obtained conformations
140       call print_mv_stat
141 crc Update dij
142 crc moved up, saves some get_diff12 calls 
143 crc
144 crc      do i1=1,nbank-1
145 crc       do i2=i1+1,nbank
146 crc        if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
147 crc         call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
148 crc         dij(i1,i2)=diff
149 crc         dij(i2,i1)=diff
150 crc        endif
151 crc       enddo
152 crc      enddo
153
154       do i=1,nbank
155        jbank(i)=1
156       enddo
157
158       return
159       end
160 c---------------------------------
161       subroutine replace_bvar(iold,inew)
162       implicit real*8 (a-h,o-z)
163       include 'DIMENSIONS'
164       include 'mpif.h'
165       include 'COMMON.IOUNITS'
166       include 'COMMON.CSA'
167       include 'COMMON.BANK'
168       include 'COMMON.CHAIN'
169       include 'COMMON.CONTROL'
170       include 'COMMON.SBRIDGE'
171
172       if (iold.gt.mxio .or. iold.lt.1 .or. inew.gt.mxio .or. inew.lt.1) 
173      &  then
174         write (iout,*) 'Dimension ERROR in REPLACE_BVAR: IOLD',iold,
175      &  ' INEW',inew
176         call mpi_abort(mpi_comm_world,ierror,ierrcode)
177       endif
178       do k=1,numch
179        do j=2,nres-1
180         do i=1,4
181          bvar(i,j,k,iold)=dihang(i,j,k,inew)
182         enddo
183        enddo
184       enddo
185       bene(iold)=etot(inew)
186       brmsn(iold)=rmsn(inew)
187       bpncn(iold)=pncn(inew)
188
189       if(bene(iold).lt.ebmin) then
190         ebmin=bene(iold)
191         ibmin=iold
192       endif
193
194       if(vdisulf) then
195         bvar_nss(iold)=nss_out(inew)
196 cd        write(iout,*) 'SS BANK',iold,bvar_nss(iold)
197         do i=1,bvar_nss(iold)
198           bvar_ss(1,i,iold)=iss_out(i,inew)
199           bvar_ss(2,i,iold)=jss_out(i,inew)
200 cd          write(iout,*) 'SS',bvar_ss(1,i,iold)-nres,
201 cd     &          bvar_ss(2,i,iold)-nres
202         enddo
203
204         bvar_ns(iold)=ns-2*bvar_nss(iold)
205 cd        write(iout,*) 'CYS #free ', bvar_ns(iold)
206            k=0
207            do i=1,ns
208              j=1
209              do while( iss(i).ne.iss_out(j,inew)-nres .and. 
210      &                 iss(i).ne.jss_out(j,inew)-nres .and. 
211      &                 j.le.nss_out(inew))
212                 j=j+1 
213              enddo
214              if (j.gt.nss_out(inew)) then            
215                k=k+1   
216                bvar_s(k,iold)=iss(i)
217              endif
218            enddo
219 cd         write(iout,*) 'CYS free',(bvar_s(k,iold),k=1,bvar_ns(iold))
220       endif
221
222       return
223       end
224 c---------------------------------------
225       subroutine write_rbank(jlee,adif,nft)
226       implicit real*8 (a-h,o-z)
227       include 'DIMENSIONS'
228       include 'COMMON.IOUNITS'
229       include 'COMMON.CSA'
230       include 'COMMON.BANK'
231       include 'COMMON.CHAIN'
232       include 'COMMON.GEO'
233
234       open(icsa_rbank,file=csa_rbank,status="unknown")
235       write (icsa_rbank,900) jlee,nbank,nstep,nft,icycle,adif
236       do k=1,nbank
237        write (icsa_rbank,952) k,rene(k),rrmsn(k),rpncn(k)
238        do j=1,numch
239         do l=2,nres-1
240          write (icsa_rbank,850) (rad2deg*rvar(i,l,j,k),i=1,4)
241         enddo
242        enddo
243       enddo
244       close(icsa_rbank)
245
246   850 format (10f8.3)
247   900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =",
248      &        i8,i10,i2,f15.5)
249   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3
250      &           ,' %NC ',0pf5.2)
251
252       return
253       end
254 c---------------------------------------
255       subroutine read_rbank(jlee,adif)
256       implicit real*8 (a-h,o-z)
257       include 'DIMENSIONS'
258       include 'mpif.h'
259       include 'COMMON.IOUNITS'
260       include 'COMMON.CSA'
261       include 'COMMON.BANK'
262       include 'COMMON.CHAIN'
263       include 'COMMON.GEO'
264       include 'COMMON.SETUP'
265       character*80 karta
266
267       open(icsa_rbank,file=csa_rbank,status="old")
268       read (icsa_rbank,901) jleer,nbankr,nstepr,nftr,icycler,adif
269       print *,jleer,nbankr,nstepr,nftr,icycler,adif
270 c       print *, 'adif from read_rbank ',adif
271       if(nbankr.ne.nbank) then
272         write (iout,*) 'ERROR in READ_BANK: NBANKR',nbankr,
273      &  ' NBANK',nbank
274         call mpi_abort(mpi_comm_world,ierror,ierrcode)
275       endif
276       if(jleer.ne.jlee) then
277         write (iout,*) 'ERROR in READ_BANK: JLEER',jleer,
278      &  ' JLEE',jlee
279         call mpi_abort(mpi_comm_world,ierror,ierrcode)
280       endif
281
282       kk=0
283       do k=1,nbankr
284         read (icsa_rbank,'(a80)') karta
285         write(iout,*) "READ_RBANK: kk=",kk
286         write(iout,*) karta
287 c        if (index(karta,"*").gt.0) then
288 c          write (iout,*) "***** Stars in bankr ***** k=",k,
289 c     &      " skipped"
290 c          do j=1,numch
291 c            do l=2,nres-1
292 c              read (30,850) (rdummy,i=1,4)
293 c            enddo
294 c          enddo
295 c        else
296           kk=kk+1
297           call reada(karta,"total E",rene(kk),1.0d20)
298           call reada(karta,"rmsd from N",rrmsn(kk),0.0d0)
299           call reada(karta,"%NC",rpncn(kk),0.0d0)
300           write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk),
301      &      "%NC",bpncn(kk),ibank(kk)
302 c          read (icsa_rbank,953) kdummy,rene(kk),rrmsn(kk),rpncn(kk)
303           do j=1,numch
304             do l=2,nres-1
305               read (icsa_rbank,850) (rvar(i,l,j,kk),i=1,4)
306 c              write (iout,850) (rvar(i,l,j,kk),i=1,4)
307               do i=1,4
308                 rvar(i,l,j,kk)=deg2rad*rvar(i,l,j,kk)
309               enddo
310             enddo
311           enddo
312 c        endif
313       enddo
314 cd      write (*,*) "read_rbank ******************* kk",kk,
315 cd     &  "nbankr",nbankr
316       if (kk.lt.nbankr) nbankr=kk
317 cd      do kk=1,nbankr
318 cd          print *,"kk=",kk
319 cd          do j=1,numch
320 cd            do l=2,nres-1
321 cd              write (*,850) (rvar(i,l,j,kk),i=1,4)
322 cd            enddo
323 cd          enddo
324 cd      enddo
325       close(icsa_rbank)
326
327   850 format (10f8.3)
328   901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5)
329   953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2)
330
331       return
332       end
333 c---------------------------------------
334       subroutine write_bank(jlee,nft)
335       implicit real*8 (a-h,o-z)
336       include 'DIMENSIONS'
337       include 'COMMON.IOUNITS'
338       include 'COMMON.CSA'
339       include 'COMMON.BANK'
340       include 'COMMON.CHAIN'
341       include 'COMMON.GEO'
342       include 'COMMON.SBRIDGE'
343       include 'COMMON.CONTROL'
344       character*7 chtmp
345       character*40 chfrm
346       external ilen
347
348       open(icsa_bank,file=csa_bank,status="unknown")
349       write (icsa_bank,900) jlee,nbank,nstep,nft,icycle,cutdif
350       write (icsa_bank,902) nglob_csa, eglob_csa
351       open (igeom,file=intname,status='UNKNOWN')
352       do k=1,nbank
353        write (icsa_bank,952) k,bene(k),brmsn(k),bpncn(k),ibank(k)
354        if (vdisulf) write (icsa_bank,'(101i4)') 
355      &    bvar_nss(k),((bvar_ss(j,i,k),j=1,2),i=1,bvar_nss(k))
356        do j=1,numch
357         do l=2,nres-1
358          write (icsa_bank,850) (rad2deg*bvar(i,l,j,k),i=1,4)
359         enddo
360        enddo
361        if (bvar_nss(k).le.9) then
362          write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k),
363      &     bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k))
364        else
365          write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k),
366      &     bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9)
367          write (igeom,'(3X,11(1X,2I3))') (bvar_ss(1,i,k),
368      &                                bvar_ss(2,i,k),i=10,bvar_nss(k))
369        endif
370        write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1)
371        write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2)
372        write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1)
373        write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1)
374       enddo
375       close(icsa_bank)
376       close(igeom)
377
378       if (nstep/200.gt.ilastnstep) then
379
380        ilastnstep=(ilastnstep+1)*1.5
381        write(chfrm,'(a2,i1,a1)') '(i',int(dlog10(dble(nstep))+1),')'
382        write(chtmp,chfrm) nstep
383        open(icsa_int,file=prefix(:ilen(prefix))
384      &         //'_'//chtmp(:ilen(chtmp))//'.int',status='UNKNOWN')
385        do k=1,nbank
386         if (bvar_nss(k).le.9) then
387          write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),
388      &  bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,bvar_nss(k))
389         else
390          write (icsa_int,'(I5,F10.3,I2,9(1X,2I3))') k,bene(k),
391      &     bvar_nss(k),(bvar_ss(1,i,k),bvar_ss(2,i,k),i=1,9)
392          write (icsa_int,'(3X,11(1X,2I3))') (bvar_ss(1,i,k),
393      &                          bvar_ss(2,i,k),i=10,bvar_nss(k))
394         endif
395         write (icsa_int,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1)
396         write (icsa_int,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2)
397         write (icsa_int,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1)
398         write (icsa_int,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1)
399        enddo
400        close(icsa_int)
401       endif
402
403
404   200 format (8f10.4)
405   850 format (10f8.3)
406   900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =",
407      &        i8,i10,i2,f15.5)
408   902 format (1x,'nglob_csa =',i4,' eglob_csa =',1pe14.5)
409   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3,
410      &        ' %NC ',0pf5.2,i5)
411
412       return
413       end
414 c---------------------------------------
415       subroutine write_bank_reminimized(jlee,nft)
416       implicit real*8 (a-h,o-z)
417       include 'DIMENSIONS'
418       include 'COMMON.IOUNITS'
419       include 'COMMON.CSA'
420       include 'COMMON.BANK'
421       include 'COMMON.CHAIN'
422       include 'COMMON.GEO'
423       include 'COMMON.SBRIDGE'
424
425       open(icsa_bank_reminimized,file=csa_bank_reminimized,
426      &  status="unknown")
427       write (icsa_bank_reminimized,900) 
428      &  jlee,nbank,nstep,nft,icycle,cutdif
429       open (igeom,file=intname,status='UNKNOWN')
430       do k=1,nbank
431        write (icsa_bank_reminimized,952) k,bene(k),brmsn(k),
432      &  bpncn(k),ibank(k)
433        do j=1,numch
434         do l=2,nres-1
435          write (icsa_bank_reminimized,850) (rad2deg*bvar(i,l,j,k),i=1,4)
436         enddo
437        enddo
438        if (nss.le.9) then
439          write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k),
440      &     nss,(ihpb(i),jhpb(i),i=1,nss)
441        else
442          write (igeom,'(I5,F10.2,I2,9(1X,2I3))') k,bene(k),
443      &     nss,(ihpb(i),jhpb(i),i=1,9)
444          write (igeom,'(3X,11(1X,2I3))') (ihpb(i),jhpb(i),i=10,nss)
445        endif
446        write (igeom,200) (rad2deg*bvar(1,i,1,k),i=2,nres-1)
447        write (igeom,200) (rad2deg*bvar(2,i,1,k),i=2,nres-2)
448        write (igeom,200) (rad2deg*bvar(3,i,1,k),i=2,nres-1)
449        write (igeom,200) (rad2deg*bvar(4,i,1,k),i=2,nres-1)
450       enddo
451       close(icsa_bank_reminimized)
452       close(igeom)
453
454   200 format (8f10.4)
455   850 format (10f8.3)
456   900 format (1x,"jlee =",i3,3x,"nbank =",i4,3x,"nstep =",
457      &        i8,i10,i2,f15.5)
458   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3
459      &        ,' %NC ',0pf5.2,i5)
460
461       return
462       end
463 c---------------------------------
464       subroutine read_bank(jlee,nft,cutdifr)
465       implicit real*8 (a-h,o-z)
466       include 'DIMENSIONS'
467       include 'COMMON.IOUNITS'
468       include 'COMMON.CSA'
469       include 'COMMON.BANK'
470       include 'COMMON.CHAIN'
471       include 'COMMON.GEO'
472       include 'COMMON.CONTROL'
473       include 'COMMON.SBRIDGE'
474       character*80 karta
475       integer ilen
476       external ilen
477
478       open(icsa_bank,file=csa_bank,status="old")
479        read (icsa_bank,901) jlee,nbank,nstep,nft,icycle,cutdifr
480        read (icsa_bank,902) nglob_csa, eglob_csa
481 c      if(jleer.ne.jlee) then
482 c        write (iout,*) 'ERROR in READ_BANK: JLEER',jleer,
483 c    &   ' JLEE',jlee
484 c        call mpi_abort(mpi_comm_world,ierror,ierrcode)
485 c      endif
486
487       kk=0
488       do k=1,nbank
489         read (icsa_bank,'(a80)') karta
490         write(iout,*) "READ_BANK: kk=",kk
491         write(iout,*) karta
492 c        if (index(karta,"*").gt.0) then
493 c          write (iout,*) "***** Stars in bank ***** k=",k,
494 c     &      " skipped"
495 c          do j=1,numch
496 c            do l=2,nres-1
497 c              read (33,850) (rdummy,i=1,4)
498 c            enddo
499 c          enddo
500 c        else
501           kk=kk+1
502           call reada(karta,"total E",bene(kk),1.0d20)
503           call reada(karta,"rmsd from N",brmsn(kk),0.0d0)
504           call reada(karta,"%NC",bpncn(kk),0.0d0)
505           read (karta(ilen(karta)-1:),*,end=111,err=111) ibank(kk)
506           goto 112
507   111     ibank(kk)=0
508   112     continue
509           write(iout,*)"total E",bene(kk),"rmsd from N",brmsn(kk),
510      &      "%NC",bpncn(kk),ibank(kk)
511 c          read (icsa_bank,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k)
512           if (vdisulf) then 
513             read (icsa_bank,'(101i4)') 
514      &        bvar_nss(kk),((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk))
515             bvar_ns(kk)=ns-2*bvar_nss(kk)
516             write(iout,*) 'read SSBOND',bvar_nss(kk),
517      &                    ((bvar_ss(j,i,kk),j=1,2),i=1,bvar_nss(kk))
518 cd          write(iout,*) 'read CYS #free ', bvar_ns(kk)
519             l=0
520             do i=1,ns
521              j=1
522              do while( iss(i).ne.bvar_ss(1,j,kk)-nres .and. 
523      &                 iss(i).ne.bvar_ss(2,j,kk)-nres .and. 
524      &                 j.le.bvar_nss(kk))
525                 j=j+1 
526              enddo
527              if (j.gt.bvar_nss(kk)) then            
528                l=l+1   
529                bvar_s(l,kk)=iss(i)
530              endif
531             enddo
532 cd            write(iout,*)'read CYS free',(bvar_s(l,kk),l=1,bvar_ns(kk))
533           endif
534           do j=1,numch
535             do l=2,nres-1
536               read (icsa_bank,850) (bvar(i,l,j,kk),i=1,4)
537 c              write (iout,850) (bvar(i,l,j,kk),i=1,4)
538               do i=1,4
539                 bvar(i,l,j,kk)=deg2rad*bvar(i,l,j,kk)
540               enddo ! l
541             enddo ! l
542           enddo ! j
543 c        endif
544       enddo ! k
545
546       if (kk.lt.nbank) nbank=kk
547 cd      write (*,*) "read_bank ******************* kk",kk,
548 cd     &  "nbank",nbank
549 cd      do kk=1,nbank
550 cd          print *,"kk=",kk
551 cd          do j=1,numch
552 cd            do l=2,nres-1
553 cd              write (*,850) (bvar(i,l,j,kk),i=1,4)
554 cd            enddo
555 cd          enddo
556 cd      enddo
557
558 c       do k=1,nbank
559 c        read (33,953) kdummy,bene(k),brmsn(k),bpncn(k),ibank(k)
560 c        do j=1,numch
561 c         do l=2,nres-1
562 c          read (33,850) (bvar(i,l,j,k),i=1,4)
563 c          do i=1,4
564 c           bvar(i,l,j,k)=deg2rad*bvar(i,l,j,k)
565 c          enddo
566 c         enddo
567 c        enddo
568 c       enddo
569       close(icsa_bank)
570
571   850 format (10f8.3)
572   952 format (1x,'#',i4,' total E ',f12.3,' rmsd from N ',f8.3,i5)
573   901 format (1x,6x,i3,3x,7x,i4,3x,7x,i8,i10,i2,f15.5)
574   902 format (1x,11x,i4,12x,1pe14.5)
575   953 format (1x,1x,i4,9x,f12.3,13x,f8.3,5x,f5.2,i5)
576
577       return
578       end
579 c---------------------------------------
580       subroutine write_bank1(jlee)
581       implicit real*8 (a-h,o-z)
582       include 'DIMENSIONS'
583       include 'COMMON.IOUNITS'
584       include 'COMMON.CSA'
585       include 'COMMON.BANK'
586       include 'COMMON.CHAIN'
587       include 'COMMON.GEO'
588
589 #if defined(AIX) || defined(PGI)
590       open(icsa_bank1,file=csa_bank1,position="append")
591 #else
592       open(icsa_bank1,file=csa_bank1,access="append")
593 #endif
594       write (icsa_bank1,900) jlee,nbank,nstep,cutdif
595       do k=1,nbank
596        write (icsa_bank1,952) k,bene(k),brmsn(k),bpncn(k),ibank(k)
597        do j=1,numch
598         do l=2,nres-1
599          write (icsa_bank1,850) (rad2deg*bvar(i,l,j,k),i=1,4)
600         enddo
601        enddo
602       enddo
603       close(icsa_bank1)
604   850 format (10f8.3)
605   900 format (4x,"jlee =",i5,3x,"nbank =",i5,3x,"nstep =",i10,f15.5)
606   952 format (1x,'#',i4,' total E ',1pe14.5,' rmsd from N ',0pf8.3
607      &       ,' %NC ',0pf5.2,i5)
608
609       return
610       end
611 c---------------------------------
612       subroutine save_is(ind)
613       implicit real*8 (a-h,o-z)
614       include 'DIMENSIONS'
615       include 'mpif.h'
616       include 'COMMON.IOUNITS'
617       include 'COMMON.CSA'
618       include 'COMMON.BANK'
619       include 'COMMON.CHAIN'
620
621       index=nbank+ind
622 c     print *, "nbank,ind,index,is(ind) ",nbank,ind,index,is(ind)
623       if (index.gt.mxio .or. index.lt.1 .or. 
624      &  is(ind).gt.mxio .or. is(ind).lt.1) then
625         write (iout,*) 'Dimension ERROR in SAVE_IS: INDEX',index,
626      &  ' IND',ind,' IS',is(ind)
627         call mpi_abort(mpi_comm_world,ierror,ierrcode)
628       endif
629       do k=1,numch
630        do j=2,nres-1
631         do i=1,4
632          bvar(i,j,k,index)=bvar(i,j,k,is(ind))
633         enddo
634        enddo
635       enddo
636       bene(index)=bene(is(ind))
637       ibank(is(ind))=1
638
639       return
640       end
641 c---------------------------------
642       subroutine select_is(n,ifar,idum)
643       implicit real*8 (a-h,o-z)
644       include 'DIMENSIONS'
645       include 'COMMON.CSA'
646       include 'COMMON.BANK'
647       dimension itag(mxio),adiff(mxio)
648
649       iuse=0
650       do i=1,nbank
651        if(ibank(i).eq.0) then
652         iuse=iuse+1
653         itag(iuse)=i
654        endif
655       enddo
656       iusesv=iuse
657
658       if(iuse.eq.0) then
659        icycle=icycle+1
660        do i=1,nbank
661         if(ibank(i).eq.2) then
662          ibank(i)=1
663         else
664          ibank(i)=0
665         endif
666        enddo
667        imade=0
668        call get_is(idum,ifar,n,imade,0)
669 ctest3       call get_is_max(idum,ifar,n,imade,0)
670       else if(iuse.eq.n) then
671        do i=1,iuse
672         is(i)=itag(i)
673         call save_is(i)
674        enddo
675       else if(iuse.lt.n) then
676 c      if(icycle.eq.0) then
677 c       do i=1,n
678 c        ind=mod(i-1,iuse)+1
679 c        is(i)=itag(ind)
680 c        call save_is(i)
681 c       enddo
682 c      else
683 c      endif
684        do i=1,iuse
685         is(i)=itag(i)
686         call save_is(i)
687        enddo
688        imade=iuse
689 c      call get_is_ran(idum,n,imade,1)
690        call get_is(idum,ifar,n,imade,1)
691 ctest3       call get_is_max(idum,ifar,n,imade,1)
692 c      if(iusesv.le.n/10) then
693        if(iusesv.le.0) then
694         icycle=icycle+1
695         do i=1,nbank
696 c        if(ibank(i).eq.2) then
697 c         ibank(i)=1
698          if(ibank(i).ge.2) then
699           ibank(i)=ibank(i)-1
700          else
701           ibank(i)=0
702          endif
703         enddo
704        endif
705       else
706        imade=0
707        call get_is(idum,ifar,n,imade,0)
708 ctest3       call get_is_max(idum,ifar,n,imade,0)
709       endif
710       iuse=iusesv
711
712       if (iuse.le.iucut) then
713          icycle=icycle+1
714          do i=1, nbank  
715             ibank(i)=0
716          enddo
717       endif  
718
719
720       return
721       end
722 c---------------------------------
723       subroutine get_is_ran(idum,n,imade,k)
724       implicit real*8 (a-h,o-z)
725       include 'DIMENSIONS'
726       include 'COMMON.CSA'
727       include 'COMMON.BANK'
728       real ran1,ran2
729       dimension itag(mxio),adiff(mxio)
730
731       do j=imade+1,n
732        iuse=0
733        do i=1,nbank
734         if(ibank(i).eq.k) then
735          iuse=iuse+1
736          itag(iuse)=i
737         endif
738        enddo
739        iran=iuse*  ran1(idum)+1
740        is(j)=itag(iran)
741        call save_is(j)
742       enddo
743
744       return
745       end
746 c---------------------------------
747       subroutine get_is(idum,ifar,n,imade,k)
748       implicit real*8 (a-h,o-z)
749       include 'DIMENSIONS'
750       include 'COMMON.CSA'
751       include 'COMMON.BANK'
752       real ran1,ran2
753       dimension itag(mxio),adiff(mxio)
754
755       iuse=0
756       do i=1,nbank
757        if(ibank(i).eq.k) then
758         iuse=iuse+1
759         itag(iuse)=i
760        endif
761       enddo
762       iran=iuse*  ran1(idum)+1
763       imade=imade+1
764       is(imade)=itag(iran)
765       call save_is(imade)
766
767       do i=imade+1,ifar-1
768        if(icycle.eq.-1) then
769         call select_iseed_max(i,k)
770        else
771         call select_iseed_min(i,k)
772 ctest4  call select_iseed_max(i,k)
773        endif
774        call save_is(i)
775       enddo
776
777       do i=ifar,n
778        call select_iseed_far(i,k)
779        call save_is(i)
780       enddo
781
782       return
783       end
784 c---------------------------------
785       subroutine select_iseed_max(imade1,ik)
786       implicit real*8 (a-h,o-z)
787       include 'DIMENSIONS'
788       include 'COMMON.CSA'
789       include 'COMMON.BANK'
790       dimension itag(mxio),adiff(mxio)
791
792       iuse=0
793       avedif=0.d0
794       difmax=0.d0
795       do n=1,nbank
796        if(ibank(n).eq.ik) then
797         iuse=iuse+1
798         diffmn=9.d190
799         do imade=1,imade1-1
800 c        m=nbank+imade
801 c        call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
802          m=is(imade)
803          diff=dij(n,m)
804          if(diff.lt.diffmn) diffmn=diff
805         enddo
806         if(diffmn.gt.difmax) difmax=diffmn
807         adiff(iuse)=diffmn
808         itag(iuse)=n
809         avedif=avedif+diffmn
810        endif
811       enddo
812
813       avedif=avedif/iuse
814 c     avedif=(avedif+difmax)/2
815       emax=-9.d190
816       do i=1,iuse
817        if(adiff(i).ge.avedif) then
818         itagi=itag(i)
819         benei=bene(itagi)
820         if(benei.gt.emax) then
821          emax=benei
822          is(imade1)=itagi  
823         endif
824        endif
825       enddo
826
827       if(ik.eq.0) iuse=iuse-1
828
829       return
830       end
831 c---------------------------------
832       subroutine select_iseed_min(imade1,ik)
833       implicit real*8 (a-h,o-z)
834       include 'DIMENSIONS'
835       include 'COMMON.CSA'
836       include 'COMMON.BANK'
837       dimension itag(mxio),adiff(mxio)
838
839       iuse=0
840       avedif=0.d0
841       difmax=0.d0
842       do n=1,nbank
843        if(ibank(n).eq.ik) then
844         iuse=iuse+1
845         diffmn=9.d190
846         do imade=1,imade1-1
847 c        m=nbank+imade
848 c        call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
849          m=is(imade)
850          diff=dij(n,m)
851          if(diff.lt.diffmn) diffmn=diff
852         enddo
853         if(diffmn.gt.difmax) difmax=diffmn
854         adiff(iuse)=diffmn
855         itag(iuse)=n
856         avedif=avedif+diffmn
857        endif
858       enddo
859
860       avedif=avedif/iuse
861 c     avedif=(avedif+difmax)/2
862       emin=9.d190
863       do i=1,iuse
864 c      print *,"i, adiff(i),avedif : ",i,adiff(i),avedif
865        if(adiff(i).ge.avedif) then
866         itagi=itag(i)
867         benei=bene(itagi)
868 c       print *,"i, benei,emin : ",i,benei,emin
869         if(benei.lt.emin) then
870          emin=benei
871          is(imade1)=itagi  
872         endif
873        endif
874       enddo
875
876       if(ik.eq.0) iuse=iuse-1
877
878 c     print *, "exiting select_iseed_min",is(imade1)
879
880       return
881       end
882 c---------------------------------
883       subroutine select_iseed_far(imade1,ik)
884       implicit real*8 (a-h,o-z)
885       include 'DIMENSIONS'
886       include 'COMMON.CSA'
887       include 'COMMON.BANK'
888
889       dmax=-9.d190
890       do n=1,nbank
891        if(ibank(n).eq.ik) then
892         diffmn=9.d190
893         do imade=1,imade1-1
894 c        m=nbank+imade
895 c        call get_diff12(bvar(1,1,1,n),bvar(1,1,1,m),diff,idiff)
896          m=is(imade)
897          diff=dij(n,m)
898          if(diff.lt.diffmn) diffmn=diff
899         enddo
900        endif
901        if(diffmn.gt.dmax) then
902         dmax=diffmn
903         is(imade1)=n  
904        endif
905       enddo
906
907       return
908       end
909 c---------------------------------
910       subroutine find_min
911       implicit real*8 (a-h,o-z)
912       include 'DIMENSIONS'
913       include 'COMMON.CSA'
914       include 'COMMON.BANK'
915       
916       ebmin=9.d190
917
918       do i=1,nbank
919        benei=bene(i)
920        if(benei.lt.ebmin) then
921         ebmin=benei
922         ibmin=i
923        endif   
924       enddo    
925
926       return
927       end   
928 c---------------------------------
929       subroutine write_csa_pdb(var,ene,nft,ik,iw_pdb)
930       implicit real*8 (a-h,o-z)
931       include 'DIMENSIONS'
932       include 'COMMON.CSA'
933       include 'COMMON.BANK'
934       include 'COMMON.VAR'
935       include 'COMMON.IOUNITS'
936       include 'COMMON.MINIM'
937       include 'COMMON.SETUP'
938       include 'COMMON.GEO'
939       include 'COMMON.CHAIN'
940       include 'COMMON.LOCAL'
941       include 'COMMON.INTERACT'
942       include 'COMMON.NAMES'
943       include 'COMMON.SBRIDGE'
944       integer lenpre,lenpot,ilen
945       external ilen
946       dimension var(maxvar)
947       character*50 titelloc
948       character*3 zahl
949
950       nmin_csa=nmin_csa+1
951       if(ene.lt.eglob_csa) then
952         eglob_csa=ene
953         nglob_csa=nglob_csa+1
954         call numstr(nglob_csa,zahl)
955
956         call var_to_geom(nvar,var)
957         call chainbuild
958         call secondary2(.false.)
959
960         lenpre=ilen(prefix)
961         open(icsa_pdb,file=prefix(:lenpre)//'@'//zahl//'.pdb')
962
963         if (iw_pdb.eq.1) then 
964           write(titelloc,'(a2,i3,a3,i9,a3,i6)')
965      &    'GM',nglob_csa,' e ',nft,' m ',nmin_csa
966         else
967           write(titelloc,'(a2,i3,a3,i9,a3,i6,a5,f5.2,a5,f5.1)') 
968      &   'GM',nglob_csa,' e ',nft,' m ',nmin_csa,' rms '
969      &        ,rmsn(ik),' %NC ',pncn(ik)*100          
970         endif
971         call pdbout(eglob_csa,titelloc,icsa_pdb)
972         close(icsa_pdb)
973       endif
974
975       return
976       end
977 c---------------------------------
978       subroutine find_max
979       implicit real*8 (a-h,o-z)
980       include 'DIMENSIONS'
981       include 'COMMON.CSA'
982       include 'COMMON.BANK'
983       
984       ebmax=-9.d190
985
986       do i=1,nbank
987        benei=bene(i)
988        if(benei.gt.ebmax) then
989         ebmax=benei
990         ibmax=i
991        endif
992       enddo
993
994       return
995       end
996 c---------------------------------
997       subroutine get_diff
998       implicit real*8 (a-h,o-z)
999       include 'DIMENSIONS'
1000       include 'COMMON.CSA'
1001       include 'COMMON.BANK'
1002
1003       tdiff=0.d0
1004       difmin=9.d190
1005       do i1=1,nbank-1
1006        do i2=i1+1,nbank
1007         if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
1008          call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
1009          dij(i1,i2)=diff
1010          dij(i2,i1)=diff
1011         else
1012          diff=dij(i1,i2)
1013         endif
1014         tdiff=tdiff+diff
1015         if(diff.lt.difmin) difmin=diff
1016        enddo
1017        dij(i1,i1)=0.0
1018       enddo
1019
1020       do i=1,nbank
1021        jbank(i)=1
1022       enddo
1023
1024       avedif=tdiff/nbank/(nbank-1)*2
1025
1026       return
1027       end
1028 c---------------------------------
1029       subroutine get_diff_p
1030       implicit real*8 (a-h,o-z)
1031       include 'DIMENSIONS'
1032       include 'COMMON.CSA'
1033       include 'COMMON.BANK'
1034       include 'COMMON.SETUP'
1035       include 'COMMON.IOUNITS'
1036       include 'mpif.h'      
1037       integer ij(mxio*mxio/2,2)
1038       double precision dij_local(mxio,mxio)
1039
1040 c      write (iout,*) 'Processor ',me,' broadcasting'
1041       call mpi_bcast(nbank,1,mpi_integer,0,CG_COMM,ierr)
1042       call mpi_bcast(numch,1,mpi_integer,0,CG_COMM,ierr)
1043       call mpi_bcast(bvar,mxang*maxres*mxch*nbank,
1044      &           mpi_double_precision,0,CG_COMM,ierr)
1045       call mpi_bcast(jbank,nbank,mpi_integer,0,CG_COMM,ierr)
1046 c      write (iout,*) 'Processor ',me,' after broadcasting'
1047 c      call flush(iout)
1048
1049       k=0
1050       do i1=1,nbank-1
1051        do i2=i1+1,nbank
1052         k=k+1
1053         ij(k,1)=i1
1054         ij(k,2)=i2
1055         dij_local(i1,i2)=0.0
1056         dij_local(i2,i1)=0.0
1057         if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
1058          dij(i1,i2)=0.0
1059          dij(i2,i1)=0.0
1060         else
1061          if(me.eq.king) then
1062            dij_local(i1,i2)=dij(i1,i2)
1063            dij_local(i2,i1)=dij(i2,i1)
1064          endif
1065         endif
1066        enddo
1067        dij(i1,i1)=0.0
1068        dij_local(i1,i1)=0.0
1069       enddo
1070
1071       do i12=me+1,nbank*(nbank-1)/2,nodes
1072         i1=ij(i12,1)
1073         i2=ij(i12,2)
1074         if(jbank(i1).eq.0.or.jbank(i2).eq.0) then
1075          call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
1076          dij_local(i1,i2)=diff
1077          dij_local(i2,i1)=diff
1078         endif
1079       enddo
1080
1081       call mpi_reduce(dij_local,dij,mxio*nbank,
1082      &           mpi_double_precision,mpi_sum,0,CG_COMM,ierr)
1083
1084
1085       if (me.eq.king) then
1086
1087        tdiff=0.d0
1088        difmin=9.d190
1089        do i1=1,nbank-1
1090         do i2=i1+1,nbank
1091 cd         write (iout,*) "!!!ppp",i1,i2,dij(i1,i2)
1092 cd         call get_diff12(bvar(1,1,1,i1),bvar(1,1,1,i2),diff)
1093 cd         write (iout,*) "!!!",i1,i2,diff
1094          tdiff=tdiff+dij(i1,i2)
1095          if(diff.lt.difmin) difmin=diff
1096         enddo
1097        enddo
1098
1099        do i=1,nbank
1100         jbank(i)=1
1101        enddo
1102
1103        avedif=tdiff/nbank/(nbank-1)*2
1104       
1105       endif
1106        
1107       return
1108       end
1109
1110 c---------------------------------
1111       subroutine estimate_cutdif(adif,xct,cutdifr)
1112       implicit real*8 (a-h,o-z)
1113       include 'DIMENSIONS'
1114       include 'COMMON.CSA'
1115       include 'COMMON.BANK'
1116       
1117       ctdif1=adif/cut2
1118
1119       exponent = cutdifr*cut1/adif
1120       exponent = dlog(exponent)/dlog(xct)
1121
1122       nexp=exponent+0.25
1123       cutdif= adif/cut1*xct**nexp
1124       if(cutdif.lt.ctdif1) cutdif=ctdif1
1125
1126       return
1127       end
1128 c---------------------------------
1129       subroutine get_is_max(idum,ifar,n,imade,k)
1130       implicit real*8 (a-h,o-z)
1131       include 'DIMENSIONS'
1132       include 'COMMON.CSA'
1133       include 'COMMON.BANK'
1134       double precision emax
1135
1136       do i=imade+1,n
1137        emax=-9.d190
1138        do j=1,nbank
1139         if(ibank(j).eq.k .and. bene(j).gt.emax) then
1140            emax=bene(j)
1141            is(i)=j
1142         endif
1143        enddo
1144        call save_is(i)
1145       enddo
1146
1147       return
1148       end
1149 c-----------------------------------------
1150       subroutine refresh_bank_master_tmscore(ifrom,econf,n)
1151       implicit real*8 (a-h,o-z)
1152       include 'DIMENSIONS'
1153       include 'COMMON.CSA'
1154       include 'COMMON.BANK'
1155       include 'COMMON.IOUNITS'
1156       include 'COMMON.CHAIN'
1157       include 'COMMON.VAR'
1158       include 'COMMON.CONTROL'
1159       include 'COMMON.SETUP'
1160       include 'mpif.h'
1161       character chacc
1162       integer iaccn
1163       double precision l_diff(mxio),denep
1164       integer info(12),idmin
1165
1166 cd      write(iout,*) 'refresh_bank_master_tmscore',ifrom
1167 cd      flush(iout)
1168
1169       info(1)=0
1170       info(2)=-2
1171       call mpi_send(info,12,mpi_integer,ifrom,idint,CG_COMM,
1172      *                  ierr)
1173       call mpi_send(bvar,mxang*maxres*mxch*nbank,mpi_double_precision,
1174      *                  ifrom,idreal,CG_COMM,ierr)
1175       call mpi_recv(idmin,1,mpi_integer,
1176      *             ifrom,idint,CG_COMM,muster,ierr)    
1177       call mpi_recv(l_diff,nbank,mpi_double_precision,
1178      *             ifrom,idreal,CG_COMM,muster,ierr)    
1179
1180        chacc=' '
1181        iaccn=0
1182        nstatnx(movernx(n),1)=nstatnx(movernx(n),1)+1
1183
1184        difmin=l_diff(idmin)
1185        if(difmin.lt.cutdif) then
1186 c n is redundant to idmin
1187         if(econf.lt.bene(idmin)) then
1188          if(econf.lt.bene(idmin)-0.01d0) then
1189           ibank(idmin)=0
1190           jbank(idmin)=0
1191          endif
1192          denep=bene(idmin)-econf
1193          call replace_bvar(idmin,n)
1194 crc Update dij
1195          do i1=1,nbank
1196            if (i1.ne.idmin) then
1197             dij(i1,idmin)=l_diff(i1)
1198             dij(idmin,i1)=l_diff(i1)
1199            endif
1200          enddo
1201          chacc='c'
1202          iaccn=idmin
1203          nstatnx(movernx(n),2)=nstatnx(movernx(n),2)+1
1204          if(idmin.eq.ibmax) call find_max
1205         endif
1206        else
1207 c got new conformation
1208         del_ene=0.0d0
1209         if(ebmax-ebmin.gt.del_ene) then
1210          denep=ebmax-econf
1211          call replace_bvar(ibmax,n)
1212 crc Update dij
1213          do i1=1,nbank
1214            if (i1.ne.ibmax) then
1215             dij(i1,ibmax)=l_diff(i1)
1216             dij(ibmax,i1)=l_diff(i1)
1217            endif
1218          enddo
1219          chacc='f'
1220          iaccn=ibmax
1221          nstatnx(movernx(n),3)=nstatnx(movernx(n),3)+1
1222          ibank(ibmax)=0
1223          jbank(ibmax)=0
1224          call find_max
1225         else
1226           call replace_bvar(ibmax,n)
1227           ibank(ibmax)=0
1228           jbank(ibmax)=0
1229           call find_max
1230         endif
1231        endif
1232 cccccccccccccccccccccccccccccccccccccccccccc
1233        if (iaccn.eq.0) then
1234         if (iref.eq.0) then 
1235          write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5)') 
1236      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
1237      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9)
1238         else
1239       write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5
1240      &       ,a5,0pf4.1,a5,f3.0)') 
1241      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
1242      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
1243      &    ' rms ',rmsn(n),' %NC ',pncn(n)*100
1244         endif
1245        else
1246         if (iref.eq.0) then
1247         write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,
1248      &         1x,a1,i4,0pf8.2,0pf9.1)') 
1249      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
1250      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
1251      &    chacc,iaccn,difmin,denep
1252         else
1253          write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4,3i5,a5,
1254      &                   0pf4.1,a5,f3.0,1x,a1,i4,0pf8.2,0pf9.1)') 
1255      &    indb(n,2),' e ',indb(n,3),indb(n,1),' etot ',econf,' mv ',
1256      &    indb(n,5),indb(n,4),indb(n,7),indb(n,8),indb(n,9),
1257      &    ' rms ',rmsn(n),' %NC ',pncn(n)*100,
1258      &     chacc,iaccn,difmin,denep
1259         endif
1260        endif
1261
1262       do i=1,nbank
1263        jbank(i)=1
1264       enddo
1265
1266       return
1267       end
1268 c-----------------------------------------
1269       subroutine refresh_bank_worker_tmscore(var)
1270       implicit real*8 (a-h,o-z)
1271       include 'DIMENSIONS'
1272       include 'COMMON.BANK'
1273       include 'COMMON.VAR'
1274       include 'COMMON.CHAIN'
1275       include 'COMMON.SETUP'
1276       include 'COMMON.IOUNITS'
1277       include 'COMMON.CSA'
1278       include 'mpif.h'
1279       integer muster(mpi_status_size)
1280       double precision var(maxvar)
1281       double precision dihang_l(mxang,maxres,mxch)
1282       double precision l_diff(mxio)
1283
1284       call mpi_recv(bvar,mxang*maxres*mxch*nbank,mpi_double_precision,
1285      *             0,idreal,CG_COMM,muster,ierr)    
1286
1287       call var_to_geom(nvar,var)
1288       do j=2,nres-1
1289         dihang_l(1,j,1)=theta(j+1)
1290         dihang_l(2,j,1)=phi(j+2)
1291         dihang_l(3,j,1)=alph(j)
1292         dihang_l(4,j,1)=omeg(j)
1293       enddo
1294
1295        difmin=9.d9
1296        do m=1,nbank
1297         call get_diff12(dihang_l,bvar(1,1,1,m),l_diff(m))
1298         if(l_diff(m).lt.difmin) then
1299          difmin=l_diff(m)
1300          idmin=m
1301         endif
1302        enddo
1303  
1304       tm_score=.false.
1305       call get_diff12(dihang_l,bvar(1,1,1,idmin),a_diff)
1306       tm_score=.true.
1307
1308 cd      write(iout,*) idmin,l_diff(idmin),a_diff
1309       call mpi_send(idmin,1,mpi_integer,0,idint,CG_COMM,
1310      *                  ierr)
1311       call mpi_send(l_diff,nbank,mpi_double_precision,
1312      *                  0,idreal,CG_COMM,ierr)
1313
1314       return
1315       end
1316 c------------------------------------------------
1317       subroutine print_mv_stat
1318       implicit real*8 (a-h,o-z)
1319       include 'DIMENSIONS'
1320       include 'COMMON.BANK'
1321       include 'COMMON.IOUNITS'
1322
1323       do i=0,mxmv
1324         if(nstatnx(i,1).ne.0) then
1325          if (i.le.9) then
1326          write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
1327      &          '## N',i,' total=',nstatnx(i,1),
1328      &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
1329      &          ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
1330          else
1331          write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
1332      &          '##N',i,' total=',nstatnx(i,1),
1333      &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
1334      &          ' %acc',(nstatnx(i,2)+nstatnx(i,3))*100.0/nstatnx(i,1)
1335          endif
1336         else
1337          if (i.le.9) then        
1338          write(iout,'(a4,i1,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
1339      &          '## N',i,' total=',nstatnx(i,1),
1340      &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
1341      &          ' %acc',0.0
1342          else
1343          write(iout,'(a3,i2,a7,i4,a7,i4,a5,i4,a5,f5.1)') 
1344      &          '##N',i,' total=',nstatnx(i,1),
1345      &          ' close=',nstatnx(i,2),' far=',nstatnx(i,3),
1346      &          ' %acc',0.0
1347          endif
1348         endif
1349       enddo
1350       call flush(iout)
1351       return
1352       end
1353 #endif