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