source/unres/src_CSA/together.F

   1       Subroutine together
   2 c  feeds tasks for parallel processing
   3       implicit real*8 (a-h,o-z)
   4       include 'DIMENSIONS'
   5       include 'mpif.h'
   6       real ran1,ran2
   7       include 'COMMON.CSA'
   8       include 'COMMON.BANK'
   9       include 'COMMON.IOUNITS'
  10       include 'COMMON.CHAIN'
  11       include 'COMMON.TIME1'
  12       include 'COMMON.SETUP'
  13       include 'COMMON.VAR'
  14       include 'COMMON.GEO'
  15       include 'COMMON.CONTROL'
  16       include 'COMMON.SBRIDGE'
  17       real tcpu
  18       double precision time_start,time_start_c,time0f,time0i
  19       logical ovrtim,sync_iter,timeout,flag,timeout1
  20       dimension muster(mpi_status_size)
  21       dimension t100(0:100),indx(mxio)
  22       dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9)
  23       dimension cout(2)
  24       parameter (rad=1.745329252d-2)
  25
  26 cccccccccccccccccccccccccccccccccccccccccccccccc
  27       IF (ME.EQ.KING) THEN
  28
  29        time0f=MPI_WTIME()
  30        ilastnstep=1
  31        sync_iter=.false.
  32        numch=1
  33        nrmsdb=0
  34        nrmsdb1=0
  35        rmsdbc1c=rmsdbc1
  36        nstep=0
  37        call csa_read
  38        call make_array
  39
  40        if(iref.ne.0) call from_int(1,0,idum)
  41
  42 c To minimize input conformation (bank conformation)
  43 c Output to $mol.reminimized
  44        if (irestart.lt.0) then
  45         call read_bank(0,nft,cutdifr)
  46         if (irestart.lt.-10) then
  47          p_cut=nres*4.d0
  48          call prune_bank(p_cut)
  49          return
  50         endif
  51         call reminimize(jlee)
  52         return
  53        endif
  54
  55        if (irestart.eq.0) then
  56         call initial_write
  57         nbank=nconf
  58         ntbank=nconf
  59         if (ntbankm.eq.0) ntbank=0
  60         nstep=0
  61         nft=0
  62         do i=1,mxio
  63          ibank(i)=0
  64          jbank(i)=0
  65         enddo
  66        else
  67         call restart_write
  68 c!bankt        call read_bankt(jlee,nft,cutdifr)
  69         call read_bank(jlee,nft,cutdifr)
  70         call read_rbank(jlee,adif)
  71         if(iref.ne.0) call from_int(1,0,idum)
  72        endif
  73
  74        nstmax=nstmax+nstep
  75        ntrial=n1+n2+n3+n4+n5+n6+n7+n8
  76        ntry=ntrial+1
  77        ntry=ntry*nseed
  78
  79 c ntrial : number of trial conformations per seed.
  80 c ntry : total number of trial conformations including seed conformations.
  81
  82        idum2=-123
  83 #ifdef G77
  84        imax=2**30-1
  85 #else
  86        imax=2**31-1
  87 #endif
  88        ENDIF
  89
  90        call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr)
  91 cccccccccccccccccccccccccccccccccccccccc
  92        do 300 jlee=1,jend
  93 cccccccccccccccccccccccccccccccccccccccc
  94   331   continue
  95         IF (ME.EQ.KING) THEN
  96         if(sync_iter) goto 333
  97         idum=-  ran2(idum2)*imax
  98         if(jlee.lt.jstart) goto 300
  99
 100 C Restart the random number generator for conformation generation
 101
 102         if(irestart.gt.0) then
 103          idum2=idum2+nstep
 104          if(idum2.le.0) idum2=-idum2+1
 105          idum=-  ran2(idum2)*imax
 106         endif
 107
 108         idumm=idum
 109         call vrndst(idumm)
 110
 111         open(icsa_seed,file=csa_seed,status="old")
 112         write(icsa_seed,*) "jlee : ",jlee
 113         close(icsa_seed)
 114
 115       call history_append
 116       write(icsa_history,*) "number of procs is ",nodes
 117       write(icsa_history,*) jlee,idum,idum2
 118       close(icsa_history)
 119
 120 cccccccccccccccccccccccccccccccccccccccccccccccc
 121   333 icycle=0
 122
 123        call history_append
 124         write(icsa_history,*) "nbank is ",nbank
 125        close(icsa_history)
 126
 127       if(irestart.eq.1) goto 111
 128       if(irestart.eq.2) then
 129        icycle=0
 130        do i=1,nbank
 131         ibank(i)=1
 132        enddo
 133        do i=nbank+1,nbank+nconf
 134         ibank(i)=0
 135        enddo
 136       endif
 137
 138 c  start energy minimization
 139       nconfr=max0(nconf+nadd,nodes-1)
 140       if (sync_iter) nconf_in=0
 141 c  king-emperor - feed input and sort output
 142        write (iout,*) "NCONF_IN",nconf_in
 143        m=0
 144        if (nconf_in.gt.0) then
 145 c al 7/2/00 - added possibility to read in some of the initial conformations
 146         do m=1,nconf_in
 147           read (intin,'(i5)',end=11,err=12) iconf
 148    12     continue
 149           write (iout,*) "write READ_ANGLES",iconf,m
 150           call read_angles(intin,*11)
 151           if (iref.eq.0) then
 152             mm=m
 153           else
 154             mm=m+1
 155           endif
 156           do j=2,nres-1
 157             dihang_in(1,j,1,mm)=theta(j+1)
 158             dihang_in(2,j,1,mm)=phi(j+2)
 159             dihang_in(3,j,1,mm)=alph(j)
 160             dihang_in(4,j,1,mm)=omeg(j)
 161           enddo
 162         enddo ! m
 163         goto 13
 164    11   write (iout,*) nconf_in," conformations requested, but only",
 165      &   m-1," found in the angle file."
 166         nconf_in=m-1
 167    13   continue
 168         m=nconf_in
 169         write (iout,*) nconf_in,
 170      &    " initial conformations have been read in."
 171        endif
 172        if (iref.eq.0) then
 173         if (nconfr.gt.nconf_in) then
 174           call make_ranvar(nconfr,m,idum)
 175           write (iout,*) nconfr-nconf_in,
 176      &     " conformations have been generated randomly."
 177         endif
 178        else
 179         nconfr=nconfr*2
 180         call from_int(nconfr,m,idum)
 181 c       call from_pdb(nconfr,idum)
 182        endif
 183        write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr
 184        write (*,*) 'Exitted from make_ranvar nconfr=',nconfr
 185        do m=1,nconfr
 186           write (iout,*) 'Initial conformation',m
 187           write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1)
 188           write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1)
 189           write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1)
 190           write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1)
 191        enddo
 192        write(iout,*)'Calling FEEDIN NCONF',nconfr
 193        time1i=MPI_WTIME()
 194        call feedin(nconfr,nft)
 195        write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i
 196        call  history_append
 197         write(icsa_history,*) jlee,nft,nbank
 198         write(icsa_history,851) (etot(i),i=1,nconfr)
 199         write(icsa_history,850) (rmsn(i),i=1,nconfr)
 200         write(icsa_history,850) (pncn(i),i=1,nconfr)
 201         write(icsa_history,*)
 202        close(icsa_history)
 203       ELSE
 204 c To minimize input conformation (bank conformation)
 205 c Output to $mol.reminimized
 206        if (irestart.lt.0) then
 207         call reminimize(jlee)
 208         return
 209        endif
 210        if (irestart.eq.1) goto 111
 211 c  soldier - perform energy minimization
 212  334   call minim_jlee
 213       ENDIF
 214
 215 ccccccccccccccccccccccccccccccccccc
 216 c need to syncronize all procs
 217       call mpi_barrier(CG_COMM,ierr)
 218       if (ierr.ne.0) then
 219        print *, ' cannot synchronize MPI'
 220        stop
 221       endif
 222 ccccccccccccccccccccccccccccccccccc
 223
 224       IF (ME.EQ.KING) THEN
 225
 226 c      print *,"ok after minim"
 227       nstep=nstep+nconf
 228       if(irestart.eq.2) then
 229        nbank=nbank+nconf
 230 c      ntbank=ntbank+nconf
 231        if(ntbank.gt.ntbankm) ntbank=ntbankm
 232       endif
 233 c      print *,"ok before indexx"
 234       if(iref.eq.0) then
 235        call indexx(nconfr,etot,indx)
 236       else
 237 c cc/al 7/6/00
 238        do k=1,nconfr
 239          indx(k)=k
 240        enddo
 241        call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1))
 242        do k=nconf_in+1,nconfr
 243          indx(k)=indx(k)+nconf_in
 244        enddo
 245 c cc/al
 246 c       call indexx(nconfr,rmsn,indx)
 247       endif
 248 c      print *,"ok after indexx"
 249       do im=1,nconf
 250        m=indx(im)
 251        if (m.gt.mxio .or. m.lt.1) then
 252          write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m
 253          call mpi_abort(mpi_comm_world,ierror,ierrcode)
 254        endif
 255        jbank(im+nbank-nconf)=0
 256        bene(im+nbank-nconf)=etot(m)
 257        rene(im+nbank-nconf)=etot(m)
 258 c!bankt       btene(im)=etot(m)
 259 c
 260        brmsn(im+nbank-nconf)=rmsn(m)
 261        bpncn(im+nbank-nconf)=pncn(m)
 262        rrmsn(im+nbank-nconf)=rmsn(m)
 263        rpncn(im+nbank-nconf)=pncn(m)
 264        if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then
 265          write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,
 266      &   ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf
 267          call mpi_abort(mpi_comm_world,ierror,ierrcode)
 268        endif
 269        do k=1,numch
 270         do j=2,nres-1
 271          do i=1,4
 272           bvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
 273           rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m)
 274 c!bankt          btvar(i,j,k,im)=dihang(i,j,k,m)
 275 c
 276          enddo
 277         enddo
 278        enddo
 279        if(iref.eq.1) then
 280         if(brmsn(im+nbank-nconf).gt.rmscut.or.
 281      &     bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9
 282        endif
 283        if(vdisulf) then
 284            bvar_ns(im+nbank-nconf)=ns-2*nss
 285            k=0
 286            do i=1,ns
 287              j=1
 288              do while( iss(i).ne.ihpb(j)-nres .and.
 289      &                 iss(i).ne.jhpb(j)-nres .and. j.le.nss)
 290               j=j+1
 291              enddo
 292              if (j.gt.nss) then
 293                k=k+1
 294                bvar_s(k,im+nbank-nconf)=iss(i)
 295              endif
 296            enddo
 297        endif
 298        bvar_nss(im+nbank-nconf)=nss
 299        do i=1,nss
 300            bvar_ss(1,i,im+nbank-nconf)=ihpb(i)
 301            bvar_ss(2,i,im+nbank-nconf)=jhpb(i)
 302        enddo
 303       enddo
 304       ENDIF
 305
 306   111 continue
 307
 308       IF (ME.EQ.KING) THEN
 309
 310       call find_max
 311       call find_min
 312
 313       call get_diff
 314       if(nbank.eq.nconf.and.irestart.eq.0) then
 315        adif=avedif
 316       endif
 317
 318       cutdif=adif/cut1
 319       ctdif1=adif/cut2
 320
 321 cd      print *,"adif,xctdif,cutdifr"
 322 cd      print *,adif,xctdif,cutdifr
 323        nst=ntotal/ntrial/nseed
 324        xctdif=(cutdif/ctdif1)**(-1.0/nst)
 325        if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr)
 326 c       print *,"ok after estimate"
 327
 328       irestart=0
 329
 330        call write_rbank(jlee,adif,nft)
 331        call write_bank(jlee,nft)
 332 c!bankt       call write_bankt(jlee,nft)
 333 c       call write_bank1(jlee)
 334        call  history_append
 335         write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1
 336         write(icsa_history,851) (bene(i),i=1,nbank)
 337         write(icsa_history,850) (brmsn(i),i=1,nbank)
 338         write(icsa_history,850) (bpncn(i),i=1,nbank)
 339         close(icsa_history)
 340   850 format(10f8.3)
 341   851 format(5e15.6)
 342
 343       ifar=nseed/4*3+1
 344       ifar=nseed+1
 345       ENDIF
 346
 347
 348       finished=.false.
 349       iter = 0
 350       irecv = 0
 351       isent =0
 352       ifrom= 0
 353       time0i=MPI_WTIME()
 354       time1i=time0i
 355       time_start_c=time0i
 356       if (.not.sync_iter) then
 357         time_start=time0i
 358         nft00=nft
 359       else
 360         sync_iter=.false.
 361       endif
 362       nft00_c=nft
 363       nft0i=nft
 364 ccccccccccccccccccccccccccccccccccccccc
 365       do while (.not. finished)
 366 ccccccccccccccccccccccccccccccccccccccc
 367 crc      print *,"iter ", iter,' isent=',isent
 368
 369       IF (ME.EQ.KING) THEN
 370 c  start energy minimization
 371
 372        if (isent.eq.0) then
 373 c  king-emperor - select seeds & make var & feed input
 374 cd        print *,'generating new conf',ntrial,MPI_WTIME()
 375         call select_is(nseed,ifar,idum)
 376
 377         open(icsa_seed,file=csa_seed,status="old")
 378         write(icsa_seed,39)
 379      &    jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed)
 380         close(icsa_seed)
 381         call  history_append
 382         write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
 383      *   ebmin,ebmax,nft,iuse,nbank,ntbank
 384         close(icsa_history)
 385
 386
 387
 388         call make_var(ntry,idum,iter)
 389 cd        print *,'new trial generated',ntrial,MPI_WTIME()
 390            time2i=MPI_WTIME()
 391            write (iout,'(a20,i4,f12.2)')
 392      &       'Time for make trial',iter+1,time2i-time1i
 393        endif
 394
 395 crc        write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial
 396 crc        call feedin(ntry,nft)
 397
 398        isent=isent+1
 399        if (isent.ge.nodes.or.iter.gt.0)  then
 400 ct            print *,'waiting ',MPI_WTIME()
 401             irecv=irecv+1
 402             call recv(0,ifrom,xout,eout,ind,timeout)
 403 ct            print *,'   ',irecv,' received from',ifrom,MPI_WTIME()
 404        else
 405             ifrom=ifrom+1
 406        endif
 407
 408 ct            print *,'sending to',ifrom,MPI_WTIME()
 409        call send(isent,ifrom,iter)
 410 ct            print *,isent,' sent ',MPI_WTIME()
 411
 412 c store results -----------------------------------------------
 413        if (isent.ge.nodes.or.iter.gt.0)  then
 414          nft=nft+ind(3)
 415          movernx(irecv)=iabs(ind(5))
 416          call getx(ind,xout,eout,cout,rad,iw_pdb,irecv)
 417          if(vdisulf) then
 418              nss_out(irecv)=nss
 419              do i=1,nss
 420                iss_out(i,irecv)=ihpb(i)
 421                jss_out(i,irecv)=jhpb(i)
 422              enddo
 423          endif
 424          if(iw_pdb.gt.0)
 425      &          call write_csa_pdb(xout,eout,nft,irecv,iw_pdb)
 426        endif
 427 c--------------------------------------------------------------
 428        if (isent.eq.ntry) then
 429            time1i=MPI_WTIME()
 430            write (iout,'(a18,f12.2,a14,f10.2)')
 431      &       'Nonsetup time     ',time1i-time_start_c,
 432      &       ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c)
 433            write (iout,'(a14,i4,f12.2,a14,f10.2)')
 434      &       'Time for iter ',iter+1,time1i-time0i,
 435      &       ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i)
 436            time0i=time1i
 437            nft0i=nft
 438            cutdif=cutdif*xctdif
 439            if(cutdif.lt.ctdif1) cutdif=ctdif1
 440            if (iter.eq.0) then
 441               print *,'UPDATING ',ntry-nodes+1,irecv
 442               write(iout,*) 'UPDATING ',ntry-nodes+1
 443               iter=iter+1
 444 c----------------- call update(ntry-nodes+1) -------------------
 445               nstep=nstep+ntry-nseed-(nodes-1)
 446               call refresh_bank(ntry-nodes+1)
 447 c!bankt              call refresh_bankt(ntry-nodes+1)
 448            else
 449 c----------------- call update(ntry) ---------------------------
 450               iter=iter+1
 451               print *,'UPDATING ',ntry,irecv
 452               write(iout,*) 'UPDATING ',ntry
 453               nstep=nstep+ntry-nseed
 454               call refresh_bank(ntry)
 455 c!bankt              call refresh_bankt(ntry)
 456            endif
 457 c-----------------------------------------------------------------
 458
 459            call write_bank(jlee,nft)
 460 c!bankt           call write_bankt(jlee,nft)
 461            call find_min
 462
 463            time1i=MPI_WTIME()
 464            write (iout,'(a20,i4,f12.2)')
 465      &       'Time for refresh ',iter,time1i-time0i
 466
 467            if(ebmin.lt.estop) finished=.true.
 468            if(icycle.gt.icmax) then
 469                call write_bank1(jlee)
 470                do i=1,nbank
 471 c                 ibank(i)=2
 472                  ibank(i)=1
 473                enddo
 474                nbank=nbank+nconf
 475                if(nbank.gt.nbankm) then
 476                    nbank=nbank-nconf
 477                    finished=.true.
 478                else
 479 crc                   goto 333
 480                    sync_iter=.true.
 481                endif
 482            endif
 483            if(nstep.gt.nstmax) finished=.true.
 484
 485            if(finished.or.sync_iter) then
 486             do ij=1,nodes-1
 487               call recv(1,ifrom,xout,eout,ind,timeout)
 488               if (timeout) then
 489                 nstep=nstep+ij-1
 490                 print *,'ERROR worker is not responding'
 491                 write(iout,*) 'ERROR worker is not responding'
 492                 time1i=MPI_WTIME()-time_start_c
 493                 print *,'End of cycle, master time for ',iter,' iters ',
 494      &             time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
 495                 write (iout,*) 'End of cycle, master time for ',iter,
 496      &             ' iters ',time1i,' sec'
 497                 write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
 498                 print *,'UPDATING ',ij-1
 499                 write(iout,*) 'UPDATING ',ij-1
 500                 call flush(iout)
 501                 call refresh_bank(ij-1)
 502 c!bankt                call refresh_bankt(ij-1)
 503                 goto 1002
 504               endif
 505 c              print *,'node ',ifrom,' finished ',ij,nft
 506               write(iout,*) 'node ',ifrom,' finished ',ij,nft
 507               call flush(iout)
 508               nft=nft+ind(3)
 509               movernx(ij)=iabs(ind(5))
 510               call getx(ind,xout,eout,cout,rad,iw_pdb,ij)
 511               if(vdisulf) then
 512                nss_out(ij)=nss
 513                do i=1,nss
 514                  iss_out(i,ij)=ihpb(i)
 515                  jss_out(i,ij)=jhpb(i)
 516                enddo
 517               endif
 518               if(iw_pdb.gt.0)
 519      &          call write_csa_pdb(xout,eout,nft,ij,iw_pdb)
 520             enddo
 521             nstep=nstep+nodes-1
 522 crc            print *,'---------bcast finished--------',finished
 523             time1i=MPI_WTIME()-time_start_c
 524             print *,'End of cycle, master time for ',iter,' iters ',
 525      &             time1i,'sec, Eval/s ',(nft-nft00_c)/time1i
 526             write (iout,*) 'End of cycle, master time for ',iter,
 527      &             ' iters ',time1i,' sec'
 528             write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i
 529
 530 ctimeout            call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
 531 ctimeout            call mpi_bcast(sync_iter,1,mpi_logical,0,
 532 ctimeout     &                                              CG_COMM,ierr)
 533             do ij=1,nodes-1
 534                tstart=MPI_WTIME()
 535                call mpi_issend(finished,1,mpi_logical,ij,idchar,
 536      &             CG_COMM,ireq,ierr)
 537                call mpi_issend(sync_iter,1,mpi_logical,ij,idchar,
 538      &             CG_COMM,ireq2,ierr)
 539                flag=.false.
 540                timeout1=.false.
 541                do while(.not. (flag .or. timeout1))
 542                  call MPI_TEST(ireq2,flag,muster,ierr)
 543                  tend1=MPI_WTIME()
 544                  if(tend1-tstart.gt.60) then
 545                   print *,'ERROR worker ',ij,' is not responding'
 546                   write(iout,*) 'ERROR worker ',ij,' is not responding'
 547                   timeout1=.true.
 548                  endif
 549                enddo
 550                if(timeout1) then
 551                 write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart
 552                 timeout=.true.
 553                else
 554                 write(iout,*) 'worker ',ij,' OK ',tend1-tstart
 555                endif
 556             enddo
 557             print *,'UPDATING ',nodes-1,ij
 558             write(iout,*) 'UPDATING ',nodes-1
 559             call refresh_bank(nodes-1)
 560 c!bankt            call refresh_bankt(nodes-1)
 561  1002       continue
 562             call write_bank(jlee,nft)
 563 c!bankt            call write_bankt(jlee,nft)
 564             call find_min
 565
 566             do i=0,mxmv
 567               do j=1,3
 568                 nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j)
 569                 nstatnx(i,j)=0
 570               enddo
 571             enddo
 572
 573             write(iout,*)'### Total stats:'
 574             do i=0,mxmv
 575              if(nstatnx_tot(i,1).ne.0) then
 576               if (i.le.9) then
 577               write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
 578      &        '### N',i,' total=',nstatnx_tot(i,1),
 579      &      ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
 580      &       (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
 581               else
 582               write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
 583      &        '###N',i,' total=',nstatnx_tot(i,1),
 584      &      ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc',
 585      &       (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1)
 586               endif
 587              else
 588               if (i.le.9) then
 589               write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)')
 590      &          '### N',i,' total=',nstatnx_tot(i,1),
 591      &          ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
 592      &          ' %acc',0.0
 593               else
 594               write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)')
 595      &          '###N',i,' total=',nstatnx_tot(i,1),
 596      &          ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),
 597      &          ' %acc',0.0
 598               endif
 599              endif
 600             enddo
 601
 602            endif
 603            if(sync_iter) goto 331
 604
 605    39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x)))
 606    40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
 607    43 format(10i8)
 608    44 format('jlee =',i3,':',4f10.1,' E =',f15.5,i7,i10)
 609
 610            isent=0
 611            irecv=0
 612        endif
 613       ELSE
 614 c  soldier - perform energy minimization
 615         call minim_jlee
 616         print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start
 617         write (iout,*) 'End of minim, proc',me,'time ',
 618      &                  MPI_WTIME()-time_start
 619         call flush(iout)
 620 ctimeout        call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr)
 621 ctimeout        call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr)
 622          call mpi_recv(finished,1,mpi_logical,0,idchar,
 623      *                 CG_COMM,muster,ierr)
 624          call mpi_recv(sync_iter,1,mpi_logical,0,idchar,
 625      *                 CG_COMM,muster,ierr)
 626         if(sync_iter) goto 331
 627       ENDIF
 628
 629 ccccccccccccccccccccccccccccccccccccccc
 630       enddo
 631 ccccccccccccccccccccccccccccccccccccccc
 632
 633       IF (ME.EQ.KING) THEN
 634         call  history_append
 635         write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
 636      *  ebmin,ebmax,nft,iuse,nbank,ntbank
 637
 638         write(icsa_history,44) jlee,0.0,0.0,0.0,
 639      &   0.0,ebmin,nstep,nft
 640         write(icsa_history,*)
 641        close(icsa_history)
 642
 643        time1i=MPI_WTIME()-time_start
 644        print *,'End of RUN, master time ',
 645      &             time1i,'sec, Eval/s ',(nft-nft00)/time1i
 646        write (iout,*) 'End of RUN, master time  ',
 647      &             time1i,' sec'
 648        write (iout,*) 'Total eval/s ',(nft-nft00)/time1i
 649
 650        if(timeout) then
 651         write(iout,*) '!!!! ERROR worker was not responding'
 652         write(iout,*) '!!!! cannot finish work normally'
 653         write(iout,*) 'Processor0 is calling MPI_ABORT'
 654         print *,'!!!! ERROR worker was not responding'
 655         print *,'!!!! cannot finish work normally'
 656         print *,'Processor0 is calling MPI_ABORT'
 657         call flush(iout)
 658         call mpi_abort(mpi_comm_world, 111, ierr)
 659        endif
 660       ENDIF
 661
 662 cccccccccccccccccccccccccccccc
 663   300 continue
 664 cccccccccccccccccccccccccccccc
 665
 666       return
 667       end
 668 c-------------------------------------------------
 669       subroutine feedin(nconf,nft)
 670 c  sends out starting conformations and receives results of energy minimization
 671       implicit real*8 (a-h,o-z)
 672       include 'DIMENSIONS'
 673       include 'COMMON.VAR'
 674       include 'COMMON.IOUNITS'
 675       include 'COMMON.CONTROL'
 676       include 'mpif.h'
 677       dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
 678      *          cout(2),ind(9),info(12)
 679       dimension muster(mpi_status_size)
 680       include 'COMMON.SETUP'
 681       parameter (rad=1.745329252d-2)
 682
 683       print *,'FEEDIN: NCONF=',nconf
 684       mm=0
 685 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 686       if (nconf .lt. nodes-1) then
 687         write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
 688      &   nconf,nodes-1
 689         write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1',
 690      &   nconf,nodes-1
 691         call mpi_abort(mpi_comm_world,ierror,ierrcode)
 692       endif
 693       do n=1,nconf
 694 c  pull out external and internal variables for next start
 695         call putx(xin,n,rad)
 696 !        write (iout,*) 'XIN from FEEDIN N=',n
 697 !        write(iout,'(8f10.4)') (xin(j),j=1,nvar)
 698         mm=mm+1
 699         if (mm.lt.nodes) then
 700 c  feed task to soldier
 701 !       print *, ' sending input for start # ',n
 702          info(1)=n
 703          info(2)=-1
 704          info(3)=0
 705          info(4)=0
 706          info(5)=0
 707          info(6)=0
 708          call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
 709      *                  ierr)
 710          call mpi_send(xin,nvar,mpi_double_precision,mm,
 711      *                  idreal,CG_COMM,ierr)
 712         else
 713 c  find an available soldier
 714          call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
 715      *                 CG_COMM,muster,ierr)
 716 !        print *, ' receiving output from start # ',ind(1)
 717          man=muster(mpi_source)
 718 c  receive final energies and variables
 719          nft=nft+ind(3)
 720          call mpi_recv(eout,1,mpi_double_precision,
 721      *                 man,idreal,CG_COMM,muster,ierr)
 722 !         print *,eout
 723 #ifdef CO_BIAS
 724          call mpi_recv(co,1,mpi_double_precision,
 725      *                 man,idreal,CG_COMM,muster,ierr)
 726          write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
 727 #endif
 728          call mpi_recv(xout,nvar,mpi_double_precision,
 729      *                 man,idreal,CG_COMM,muster,ierr)
 730 !         print *,nvar , ierr
 731 c  feed next task to soldier
 732 !        print *, ' sending input for start # ',n
 733          info(1)=n
 734          info(2)=-1
 735          info(3)=0
 736          info(4)=0
 737          info(5)=0
 738          info(6)=0
 739          info(7)=0
 740          info(8)=0
 741          info(9)=0
 742          call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
 743      *                  ierr)
 744          call mpi_send(xin,nvar,mpi_double_precision,man,
 745      *                  idreal,CG_COMM,ierr)
 746 c  retrieve latest results
 747          call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
 748          if(iw_pdb.gt.0)
 749      &        call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
 750         endif
 751       enddo
 752 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 753 c  no more input
 754 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 755       do j=1,nodes-1
 756 c  wait for a soldier
 757        call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
 758      *               CG_COMM,muster,ierr)
 759 crc       if (ierr.ne.0) go to 30
 760 !      print *, ' receiving output from start # ',ind(1)
 761        man=muster(mpi_source)
 762 c  receive final energies and variables
 763        nft=nft+ind(3)
 764        call mpi_recv(eout,1,
 765      *               mpi_double_precision,man,idreal,
 766      *               CG_COMM,muster,ierr)
 767 !       print *,eout
 768 #ifdef CO_BIAS
 769          call mpi_recv(co,1,mpi_double_precision,
 770      *                 man,idreal,CG_COMM,muster,ierr)
 771          write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
 772 #endif
 773 crc       if (ierr.ne.0) go to 30
 774        call mpi_recv(xout,nvar,mpi_double_precision,
 775      *               man,idreal,CG_COMM,muster,ierr)
 776 !       print *,nvar , ierr
 777 crc       if (ierr.ne.0) go to 30
 778 c  halt soldier
 779        info(1)=0
 780        info(2)=-1
 781        info(3)=0
 782        info(4)=0
 783        info(5)=0
 784        info(6)=0
 785        call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,
 786      *                ierr)
 787 c  retrieve results
 788        call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1))
 789        if(iw_pdb.gt.0)
 790      &          call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb)
 791       enddo
 792 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
 793       return
 794    10 print *, ' dispatching error'
 795       call mpi_abort(mpi_comm_world,ierror,ierrcode)
 796       return
 797    20 print *, ' communication error'
 798       call mpi_abort(mpi_comm_world,ierror,ierrcode)
 799       return
 800    30 print *, ' receiving error'
 801       call mpi_abort(mpi_comm_world,ierror,ierrcode)
 802       return
 803       end
 804 cccccccccccccccccccccccccccccccccccccccccccccccccc
 805       subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k)
 806 c  receives and stores data from soldiers
 807       implicit real*8 (a-h,o-z)
 808       include 'DIMENSIONS'
 809       include 'COMMON.IOUNITS'
 810       include 'COMMON.CSA'
 811       include 'COMMON.BANK'
 812       include 'COMMON.VAR'
 813       include 'COMMON.CHAIN'
 814       include 'COMMON.CONTACTS'
 815       dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1)
 816 cjlee
 817       double precision przes(3),obr(3,3)
 818       logical non_conv
 819 cjlee
 820       iw_pdb=2
 821       if (k.gt.mxio .or. k.lt.1) then
 822         write (iout,*)
 823      &   'ERROR - dimensions of ANGMIN have been exceeded K=',k
 824         call mpi_abort(mpi_comm_world,ierror,ierrcode)
 825       endif
 826 c  store ind()
 827       do j=1,9
 828        indb(k,j)=ind(j)
 829       enddo
 830 c  store energies
 831       etot(k)=eout(1)
 832 c  retrieve dihedral angles etc
 833       call var_to_geom(nvar,xout)
 834       do j=2,nres-1
 835         dihang(1,j,1,k)=theta(j+1)
 836         dihang(2,j,1,k)=phi(j+2)
 837         dihang(3,j,1,k)=alph(j)
 838         dihang(4,j,1,k)=omeg(j)
 839       enddo
 840       dihang(2,nres-1,1,k)=0.0d0
 841 cjlee
 842       if(iref.eq.0) then
 843        iw_pdb=1
 844 cd       write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)')
 845 cd     &      ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ',
 846 cd     &      ind(5),ind(4)
 847        return
 848       endif
 849       call chainbuild
 850 c     call dihang_to_c(dihang(1,1,1,k))
 851 c     call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv)
 852 c     call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv)
 853 c           call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup),
 854 c    &                 nsup,przes,obr,non_conv)
 855 c      rmsn(k)=dsqrt(rms)
 856
 857        call rmsd_csa(rmsn(k))
 858        call contact(.false.,ncont,icont,co)
 859        pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref)
 860
 861 cd       write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5
 862 cd     &      ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)')
 863 cd     &    ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ',
 864 cd     &    rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ',
 865 cd     &    ind(5),ind(4)
 866
 867
 868       if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0
 869       return
 870       end
 871 cccccccccccccccccccccccccccccccccccccccccccccccccc
 872       subroutine putx(xin,n,rad)
 873 c  gets starting variables
 874       implicit real*8 (a-h,o-z)
 875       include 'DIMENSIONS'
 876       include 'COMMON.CSA'
 877       include 'COMMON.BANK'
 878       include 'COMMON.VAR'
 879       include 'COMMON.CHAIN'
 880       include 'COMMON.IOUNITS'
 881       dimension xin(maxvar)
 882
 883 c  pull out starting values for variables
 884 !       write (iout,*)'PUTX: N=',n
 885       do m=1,numch
 886 !        write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1)
 887 !        write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1)
 888 !        write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1)
 889 !        write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1)
 890        do j=2,nres-1
 891         theta(j+1)=dihang_in(1,j,m,n)
 892         phi(j+2)=dihang_in(2,j,m,n)
 893         alph(j)=dihang_in(3,j,m,n)
 894         omeg(j)=dihang_in(4,j,m,n)
 895        enddo
 896       enddo
 897 c  set up array of variables
 898       call geom_to_var(nvar,xin)
 899 !       write (iout,*) 'xin in PUTX N=',n
 900 !       call intout
 901 !       write (iout,'(8f10.4)') (xin(i),i=1,nvar)
 902       return
 903       end
 904 c--------------------------------------------------------
 905       subroutine putx2(xin,iff,n)
 906 c  gets starting variables
 907       implicit real*8 (a-h,o-z)
 908       include 'DIMENSIONS'
 909       include 'COMMON.CSA'
 910       include 'COMMON.BANK'
 911       include 'COMMON.VAR'
 912       include 'COMMON.CHAIN'
 913       include 'COMMON.IOUNITS'
 914       dimension xin(maxvar),iff(maxres)
 915
 916 c  pull out starting values for variables
 917       do m=1,numch
 918        do j=2,nres-1
 919         theta(j+1)=dihang_in2(1,j,m,n)
 920         phi(j+2)=dihang_in2(2,j,m,n)
 921         alph(j)=dihang_in2(3,j,m,n)
 922         omeg(j)=dihang_in2(4,j,m,n)
 923        enddo
 924       enddo
 925 c  set up array of variables
 926       call geom_to_var(nvar,xin)
 927
 928       do i=1,nres
 929         iff(i)=iff_in(i,n)
 930       enddo
 931       return
 932       end
 933
 934 c-------------------------------------------------------
 935       subroutine prune_bank(p_cut)
 936       implicit real*8 (a-h,o-z)
 937       include 'DIMENSIONS'
 938       include 'mpif.h'
 939       include 'COMMON.CSA'
 940       include 'COMMON.BANK'
 941       include 'COMMON.IOUNITS'
 942       include 'COMMON.CHAIN'
 943       include 'COMMON.TIME1'
 944       include 'COMMON.SETUP'
 945 c---------------------------
 946 c This subroutine prunes bank conformations using p_cut
 947 c---------------------------
 948
 949       nprune=0
 950       nprune=nprune+1
 951       m=1
 952       do k=1,numch
 953        do j=2,nres-1
 954         do i=1,4
 955          dihang(i,j,k,nprune)=bvar(i,j,k,m)
 956         enddo
 957        enddo
 958       enddo
 959       bene(nprune)=bene(m)
 960       brmsn(nprune)=brmsn(m)
 961       bpncn(nprune)=bpncn(m)
 962
 963       do m=2,nbank
 964        ddmin=9.d190
 965        do ip=1,nprune
 966         call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff)
 967         if(diff.lt.p_cut) goto 100
 968         if(diff.lt.ddmin) ddmin=diff
 969        enddo
 970        nprune=nprune+1
 971        do k=1,numch
 972         do j=2,nres-1
 973          do i=1,4
 974           dihang(i,j,k,nprune)=bvar(i,j,k,m)
 975          enddo
 976         enddo
 977        enddo
 978        bene(nprune)=bene(m)
 979        brmsn(nprune)=brmsn(m)
 980        bpncn(nprune)=bpncn(m)
 981   100  continue
 982        write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin
 983       enddo
 984       nbank=nprune
 985       print *, 'Pruning :',m,nprune,p_cut
 986       call write_bank(0,0)
 987
 988       return
 989       end
 990 c-------------------------------------------------------
 991
 992       subroutine reminimize(jlee)
 993       implicit real*8 (a-h,o-z)
 994       include 'DIMENSIONS'
 995       include 'mpif.h'
 996       include 'COMMON.CSA'
 997       include 'COMMON.BANK'
 998       include 'COMMON.IOUNITS'
 999       include 'COMMON.CHAIN'
1000       include 'COMMON.TIME1'
1001       include 'COMMON.SETUP'
1002 c---------------------------
1003 c This subroutine re-minimizes bank conformations:
1004 c---------------------------
1005
1006        ntry=nbank
1007
1008        call find_max
1009        call find_min
1010
1011        if (me.eq.king) then
1012         open(icsa_history,file=csa_history,status="old")
1013          write(icsa_history,*) "Re-minimization",nodes,"nodes"
1014          write(icsa_history,851) (bene(i),i=1,nbank)
1015          write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1016      *   ebmin,ebmax,nft,iuse,nbank,ntbank
1017         close(icsa_history)
1018         do index=1,ntry
1019          do k=1,numch
1020           do j=2,nres-1
1021            do i=1,4
1022             dihang_in(i,j,k,index)=bvar(i,j,k,index)
1023            enddo
1024           enddo
1025          enddo
1026         enddo
1027         nft=0
1028         call feedin(ntry,nft)
1029        else
1030         call minim_jlee
1031        endif
1032
1033        call find_max
1034        call find_min
1035
1036        if (me.eq.king) then
1037         do i=1,ntry
1038          call replace_bvar(i,i)
1039         enddo
1040         open(icsa_history,file=csa_history,status="old")
1041          write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax,
1042      *   ebmin,ebmax,nft,iuse,nbank,ntbank
1043          write(icsa_history,851) (bene(i),i=1,nbank)
1044         close(icsa_history)
1045         call write_bank_reminimized(jlee,nft)
1046        endif
1047
1048    40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4)
1049   851 format(5e15.6)
1050   850 format(5e15.10)
1051 c  850 format(10f8.3)
1052
1053       return
1054       end
1055 c-------------------------------------------------------
1056       subroutine send(n,mm,it)
1057 c  sends out starting conformation for minimization
1058       implicit real*8 (a-h,o-z)
1059       include 'DIMENSIONS'
1060       include 'COMMON.VAR'
1061       include 'COMMON.IOUNITS'
1062       include 'COMMON.CONTROL'
1063       include 'COMMON.BANK'
1064       include 'COMMON.CHAIN'
1065       include 'mpif.h'
1066       dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1067      *          cout(2),ind(8),xin2(maxvar),iff(maxres),info(12)
1068       dimension muster(mpi_status_size)
1069       include 'COMMON.SETUP'
1070       parameter (rad=1.745329252d-2)
1071
1072       if (isend2(n).eq.0) then
1073 c  pull out external and internal variables for next start
1074         call putx(xin,n,rad)
1075         info(1)=n
1076         info(2)=it
1077         info(3)=movenx(n)
1078         info(4)=nss_in(n)
1079         info(5)=parent(1,n)
1080         info(6)=parent(2,n)
1081
1082         if (movenx(n).eq.14.or.movenx(n).eq.17) then
1083           info(7)=idata(1,n)
1084           info(8)=idata(2,n)
1085         else if (movenx(n).eq.16) then
1086           info(7)=idata(1,n)
1087           info(8)=idata(2,n)
1088           info(10)=idata(3,n)
1089           info(11)=idata(4,n)
1090           info(12)=idata(5,n)
1091         else
1092          info(7)=0
1093          info(8)=0
1094          info(10)=0
1095          info(11)=0
1096          info(12)=0
1097         endif
1098
1099         if (movenx(n).eq.15) then
1100          info(9)=parent(3,n)
1101         else
1102          info(9)=0
1103         endif
1104         call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1105      *                  ierr)
1106         call mpi_send(xin,nvar,mpi_double_precision,mm,
1107      *                  idreal,CG_COMM,ierr)
1108       else
1109 c  distfit & minimization for n7 move
1110         info(1)=-n
1111         info(2)=it
1112         info(3)=movenx(n)
1113         info(4)=nss_in(n)
1114         info(5)=parent(1,n)
1115         info(6)=parent(2,n)
1116         info(7)=0
1117         info(8)=0
1118         info(9)=0
1119         call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM,
1120      *                  ierr)
1121         call putx2(xin,iff,isend2(n))
1122         call mpi_send(xin,nvar,mpi_double_precision,mm,
1123      *                  idreal,CG_COMM,ierr)
1124         call mpi_send(iff,nres,mpi_integer,mm,
1125      *                  idint,CG_COMM,ierr)
1126         call putx(xin2,n,rad)
1127         call mpi_send(xin2,nvar,mpi_double_precision,mm,
1128      *                  idreal,CG_COMM,ierr)
1129       endif
1130       if (vdisulf.and.nss_in(n).ne.0) then
1131         call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm,
1132      *                  idint,CG_COMM,ierr)
1133         call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm,
1134      *                  idint,CG_COMM,ierr)
1135       endif
1136       return
1137       end
1138 c-------------------------------------------------
1139
1140       subroutine recv(ihalt,man,xout,eout,ind,tout)
1141 c  receives results of energy minimization
1142       implicit real*8 (a-h,o-z)
1143       include 'DIMENSIONS'
1144       include 'COMMON.VAR'
1145       include 'COMMON.IOUNITS'
1146       include 'COMMON.CONTROL'
1147       include 'COMMON.SBRIDGE'
1148       include 'COMMON.BANK'
1149       include 'COMMON.CHAIN'
1150       include 'mpif.h'
1151       dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1),
1152      *          cout(2),ind(9),info(12)
1153       dimension muster(mpi_status_size)
1154       include 'COMMON.SETUP'
1155       logical tout,flag
1156       double precision twait,tstart,tend1
1157       parameter(twait=600.0d0)
1158
1159 c  find an available soldier
1160        tout=.false.
1161        flag=.false.
1162        tstart=MPI_WTIME()
1163        do while(.not. (flag .or. tout))
1164          call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag,
1165      *            muster,ierr)
1166          tend1=MPI_WTIME()
1167          if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true.
1168 c_error         if(tend1-tstart.gt.twait) tout=.true.
1169        enddo
1170        if (tout) then
1171          write(iout,*) 'ERROR = timeout for recv ',tend1-tstart
1172          call flush(iout)
1173          return
1174        endif
1175        man=muster(mpi_source)
1176
1177 ctimeout         call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint,
1178 ctimeout     *                 CG_COMM,muster,ierr)
1179 !        print *, ' receiving output from start # ',ind(1)
1180 ct         print *,'receiving ',MPI_WTIME()
1181 ctimeout         man=muster(mpi_source)
1182          call mpi_recv(ind,9,mpi_integer,man,idint,
1183      *                 CG_COMM,muster,ierr)
1184 ctimeout
1185 c  receive final energies and variables
1186          call mpi_recv(eout,1,mpi_double_precision,
1187      *                 man,idreal,CG_COMM,muster,ierr)
1188 !         print *,eout
1189 #ifdef CO_BIAS
1190          call mpi_recv(co,1,mpi_double_precision,
1191      *                 man,idreal,CG_COMM,muster,ierr)
1192          write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co
1193 #endif
1194          call mpi_recv(xout,nvar,mpi_double_precision,
1195      *                 man,idreal,CG_COMM,muster,ierr)
1196 !         print *,nvar , ierr
1197          if(vdisulf) nss=ind(6)
1198          if(vdisulf.and.nss.ne.0) then
1199           call mpi_recv(ihpb,nss,mpi_integer,
1200      *                 man,idint,CG_COMM,muster,ierr)
1201           call mpi_recv(jhpb,nss,mpi_integer,
1202      *                 man,idint,CG_COMM,muster,ierr)
1203          endif
1204 c  halt soldier
1205        if(ihalt.eq.1) then
1206 c        print *,'sending halt to ',man
1207         write(iout,*) 'sending halt to ',man
1208         info(1)=0
1209         call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr)
1210        endif
1211       return
1212       end
1213
1214 c----------------------------------------------------------
1215       subroutine history_append
1216       implicit real*8 (a-h,o-z)
1217       include 'DIMENSIONS'
1218       include 'COMMON.IOUNITS'
1219
1220 #if defined(AIX) || defined(PGI)
1221        open(icsa_history,file=csa_history,position="append")
1222 #else
1223        open(icsa_history,file=csa_history,access="append")
1224 #endif
1225        return
1226        end