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