source/unres/src_CSA/bank.F

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