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