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