source/unres/src_MD/src/together.F

   1 #ifdef MPI
   2       Subroutine together
   3 c  feeds tasks for parallel processing
   4       implicit real*8 (a-h,o-z)
   5       include 'DIMENSIONS'
   6       include 'mpif.h'
   7       real ran1,ran2
   8       include 'COMMON.CSA'
   9       include 'COMMON.BANK'
  10       include 'COMMON.IOUNITS'
  11       include 'COMMON.CHAIN'
  12       include 'COMMON.TIME1'
  13       include 'COMMON.SETUP'
  14       include 'COMMON.VAR'
  15       include 'COMMON.GEO'
  16       include 'COMMON.CONTROL'
  17       include 'COMMON.SBRIDGE'
  18       real tcpu
  19       double precision time_start,time_start_c,time0f,time0i
  20       logical ovrtim,sync_iter,timeout,flag,timeout1
  21       dimension muster(mpi_status_size)
  22       dimension t100(0:100),indx(mxio)
  23       dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9)
  24       dimension cout(2)
  25       parameter (rad=1.745329252d-2)
  26
  27 cccccccccccccccccccccccccccccccccccccccccccccccc
  28       IF (ME.EQ.KING) THEN
  29
  30        time0f=MPI_WTIME()
  31        ilastnstep=1
  32        sync_iter=.false.
  33        numch=1
  34        nrmsdb=0
  35        nrmsdb1=0
  36        rmsdbc1c=rmsdbc1
  37        nstep=0
  38        call csa_read
  39        call make_array
  40
  41        if(iref.ne.0) call from_int(1,0,idum)
  42
  43 c To minimize input conformation (bank conformation)
  44 c Output to $mol.reminimized
  45        if (irestart.lt.0) then
  46         call read_bank(0,nft,cutdifr)
  47         if (irestart.lt.-10) then
  48          p_cut=nres*4.d0
  49          call prune_bank(p_cut)
  50          return
  51         endif
  52         call reminimize(jlee)
  53         return
  54        endif
  55
  56        if (irestart.eq.0) then
  57         call initial_write
  58         nbank=nconf
  59         ntbank=nconf
  60         if (ntbankm.eq.0) ntbank=0
  61         nstep=0
  62         nft=0
  63         do i=1,mxio
  64          ibank(i)=0
  65          jbank(i)=0
  66         enddo
  67        else
  68         call restart_write
  69 c!bankt        call read_bankt(jlee,nft,cutdifr)
  70         call read_bank(jlee,nft,cutdifr)
  71         call read_rbank(jlee,adif)
  72         if(iref.ne.0) call from_int(1,0,idum)
  73        endif
  74
  75        nstmax=nstmax+nstep
  76        ntrial=n1+n2+n3+n4+n5+n6+n7+n8
  77        ntry=ntrial+1
  78        ntry=ntry*nseed
  79
  80 c ntrial : number of trial conformations per seed.
  81 c ntry : total number of trial conformations including seed conformations.
  82
  83        idum2=-123
  84        imax=2**31-1
  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)
 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
1223 #endif