source/maxlik/src_MD_T_maxlik-NEWCORR.safe/make_list_sc.F

   1       subroutine make_list(lprn,first_call,nvarr,x)
   2       implicit none
   3       include "DIMENSIONS"
   4       include "DIMENSIONS.ZSCOPT"
   5 #ifdef MPI
   6       include "mpif.h"
   7       integer IERROR,ErrCode,Status(MPI_STATUS_SIZE,10)
   8       integer req(10),msg_in(5),msg_out(5),address,size
   9       character*1 buffer(8*(2*maxstr_proc*nntyp+8000))
  10       include "COMMON.MPI"
  11 #endif
  12       include "COMMON.WEIGHTS"
  13       include "COMMON.WEIGHTDER"
  14       include "COMMON.ENERGIES"
  15       include "COMMON.IOUNITS"
  16       include "COMMON.VMCPAR"
  17       include "COMMON.NAMES"
  18       include "COMMON.INTERACT"
  19       include "COMMON.TIME1"
  20       include "COMMON.CHAIN"
  21       include "COMMON.PROTFILES"
  22       include "COMMON.VAR"
  23       include "COMMON.GEO"
  24       include "COMMON.OPTIM"
  25       include "COMMON.CLASSES"
  26       include "COMMON.COMPAR"
  27       include "COMMON.TORSION"
  28 C Define local variables
  29       integer nvarr
  30       integer i,ii,iii,ibatch,kkk,jj,j,k,kk,l,iprot,ib,nn
  31       integer ipass_conf,istart_conf,iend_conf,Previous,Next
  32       double precision energia(0:max_ene)
  33       double precision etoti,elowesti,dene
  34       double precision tcpu_ini,tcpu_fin,tcpu
  35       double precision elowest_t(2,maxT),etot_aux,enepsjk,
  36      &  emini,elowest_aux(2,maxT)
  37       integer iroof,icant
  38       external iroof,icant
  39       logical lprn,first_call
  40       logical*1 lflag(maxstr)
  41       integer ipermut(maxstr)
  42       integer list_conf_(maxstr,maxprot)
  43       double precision x(nvarr)
  44       double precision ftune_eps
  45       external ftune_eps
  46 #ifdef MPI
  47       double precision e_total_(maxstr_proc)
  48 #endif
  49       write (iout,*) "Making the worklist of conformations."
  50       write (iout,*) "enecut",(enecut(i),i=1,nprot)
  51       write (iout,*) "first_call ",first_call," nvarr",nvarr
  52       tcpu_ini = tcpu()
  53       do iprot=1,nprot
  54         do i=1,ntot(iprot)
  55           list_conf(i,iprot)=i
  56         enddo
  57         ntot_work(iprot)=ntot(iprot)
  58       enddo
  59 #ifdef MPI
  60 c
  61 c Divide the whole database between processors
  62 c
  63       Previous = me1-1
  64       Next = me1+1
  65       if (Previous.lt.0) Previous = Nprocs-1
  66       if (Next.ge.Nprocs) Next = 0
  67       call work_partition(lprn)
  68 #endif
  69 c
  70 c Loop over proteins
  71 c
  72       DO iprot=1,nprot
  73
  74        call restore_molinfo(iprot)
  75 c      write (iout,*) "Processor",me," iprot",iprot,
  76 c     & " indstart",indstart(me1,iprot)," indend",indend(me1,iprot),
  77 c     & " init_ene",init_ene," mod_fourier",mod_fourier(0),
  78 c     & " mod_elec",mod_elec," mod_scp",mod_scp
  79       call restore_molinfo(iprot)
  80 c
  81 c Loop over the conformations of protein IPROT assigned to the current processor.
  82 c The conformations are read off a DA scratchfile and processed in passes, each
  83 c of which requires no more than MAXSTR_PROC conformations to be stored in memory
  84 c simultaneously.
  85 c
  86       if (.not.init_ene .and. mod_fourier(nloctyp).eq.0
  87      &  .and. .not. mod_elec .and. .not. mod_scp) then
  88         open (ientin,file=benefiles(iprot),status="old",
  89      &    form="unformatted",access="direct",recl=lenrec_ene(iprot))
  90       else
  91         open (icbase,file=bprotfiles(iprot),status="old",
  92      &    form="unformatted",access="direct",recl=lenrec(iprot))
  93         open (ientout,file=benefiles(iprot),status="old",
  94      &    form="unformatted",access="direct",recl=lenrec_ene(iprot))
  95       endif
  96
  97 #ifdef MPI
  98       nchunk_ene(iprot) = iroof(scount(me1,iprot),maxstr)
  99       nchunk_conf(iprot) = iroof(scount(me1,iprot),maxstr_proc)
 100       write (iout,*)"Protein",iprot," energy evaluation in",
 101      &   nchunk_conf(iprot)," passes."
 102       ipass_conf=0
 103       jj=0
 104       do i=indstart(me1,iprot),indend(me1,iprot),maxstr_proc
 105       ipass_conf=ipass_conf+1
 106       write (iout,*) "MAKE_LIST: Pass",ipass_conf
 107       istart_conf=i
 108       iend_conf=min0(i+maxstr_proc-1,indend(me1,iprot))
 109 #else
 110       nchunk_ene(iprot) = iroof(ntot(iprot),maxstr)
 111       nchunk_conf(iprot) = iroof(ntot(iprot),maxstr_proc)
 112       write (iout,*)"Protein",iprot," energy evaluation in",
 113      &   nchunk_conf," passes."
 114       ipass_conf=0
 115       do i=1,ntot(iprot),maxstr_proc
 116       ipass_conf=ipass_conf+1
 117       write (iout,*) "MAKE_LIST: Pass",ipass_conf
 118       istart_conf=i
 119       iend_conf=min0(i+maxstr_proc-1,ntot(iprot))
 120 #endif
 121       ii=0
 122 c
 123 c Read the chunk of conformations off a DA scratchfile.
 124 c
 125       if (.not.init_ene .and. mod_fourier(nloctyp).eq.0
 126      &  .and. .not. mod_elec .and. .not. mod_scp) then
 127 c
 128 c If energy components have been pre-computed read them off a DA file.
 129 c
 130         call daread_ene(iprot,istart_conf,iend_conf)
 131         do iii=istart_conf,iend_conf
 132           ii=ii+1
 133           jj=jj+1
 134           if (mod_side) then
 135             enetb(ii,1,iprot)=0.0d0
 136             do j=1,ntyp
 137               do k=1,j
 138                 enetb(ii,1,iprot)=enetb(ii,1,iprot)+ftune_eps(eps(j,k))*
 139      &                 eneps(1,icant(j,k),ii,iprot)+
 140      &                 eps(j,k)*eneps(2,icant(j,k),ii,iprot)
 141               enddo
 142             enddo
 143           endif
 144           etot_aux=0.0d0
 145           do j=1,n_ene
 146             etot_aux=etot_aux+ww(j)*enetb(ii,j,iprot)
 147           enddo
 148           e_total(iii,iprot)=etot_aux
 149 #ifdef DEBUG
 150           write (iout,'(i5,16(1pe12.4))') iii,
 151      &    (enetb(ii,j,iprot),j=1,n_ene),e_total(iii,iprot)
 152           call flush(iout)
 153 #endif
 154         enddo
 155         if (first_call .and. mod_side) then
 156           write (iout,*) "Callig x2w"
 157           call flush(iout)
 158           call x2w(nvarr,x_orig)
 159           write (iout,*) "After x2w"
 160           call flush(iout)
 161           ii=0
 162           do iii=istart_conf,iend_conf
 163             ii=ii+1
 164             enetb_oorig(ii,1,iprot)=0.0d0
 165             do j=1,ntyp
 166               do k=1,j
 167                 enetb_oorig(ii,1,iprot)=enetb_oorig(ii,1,iprot)+
 168      &              ftune_eps(eps(j,k))*eneps(1,icant(j,k),ii,iprot)+
 169      &              eps(j,k)*eneps(2,icant(j,k),ii,iprot)
 170               enddo
 171             enddo
 172             do j=2,n_ene
 173               enetb_oorig(ii,j,iprot)=enetb(ii,j,iprot)
 174             enddo
 175           enddo
 176           call x2w(nvarr,x)
 177         endif
 178       else
 179         call daread_ccoords(iprot,istart_conf,iend_conf)
 180 c
 181 c Compute the energies of the conformations currently in memory and compute
 182 c the lowest energies.
 183 c
 184         do iii=istart_conf,iend_conf
 185           ii=ii+1
 186           jj=jj+1
 187           call restore_ccoords(iprot,ii)
 188           call int_from_cart1(.false.)
 189 #ifdef DEBUG
 190           write (iout,*) "Before etotal",iii,i
 191           call flush(iout)
 192 #endif
 193           call etotal(energia(0))
 194 #ifdef DEBUG
 195           write (iout,*) "After etotal",i
 196           call flush(iout)
 197           call enerprint(energia(0))
 198 c          write (iout,'(i5,16(1pe12.4))') i,
 199 c     &    (energia(j),j=1,n_ene),energia(0)
 200           call flush(iout)
 201 #endif
 202 #ifdef DEBUG
 203           write (iout,*) "Conformation:",i
 204           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 205           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 206           write (iout,'(8f10.4)') (vbld(k),k=2,nres)
 207           write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
 208           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 209           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 210           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 211           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 212           call enerprint(energia(0))
 213 #endif
 214           e_total(iii,iprot)=energia(0)
 215           do j=1,n_ene
 216             enetb(ii,j,iprot)=energia(j)
 217           enddo
 218           do j=1,ntyp
 219             do k=1,j
 220              eneps(1,icant(j,k),ii,iprot)=eneps_temp(1,icant(j,k))
 221              eneps(2,icant(j,k),ii,iprot)=eneps_temp(2,icant(j,k))
 222             enddo
 223           enddo
 224 #ifdef DEBUG
 225           write (iout,'(i5,20(1pe12.4))') iii,
 226      &    (energia(j),j=1,n_ene),energia(0),eini(iii,iprot),
 227      &    entfac(iii,iprot)
 228           call flush(iout)
 229 #endif
 230           if (energia(0).ge.1.0d99) then
 231             write (iout,*)
 232      &    "MAKE_LIST:CHUJ NASTAPIL in energy evaluation for",
 233      &    " point",i,". Probably NaNs in some of the energy components."
 234             write (iout,*) "The components of the energy are:"
 235             call enerprint(energia(0))
 236             write (iout,*) "Conformation:",i
 237             write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 238             write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 239             write (iout,'(8f10.4)') (vbld(k),k=2,nres)
 240             write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
 241             write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 242             write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 243             write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 244             write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 245             write (iout,*) "Calculation terminated at this point.",
 246      &       " Check the database of conformations"
 247 #ifdef MPI
 248             call MPI_Abort(MPI_COMM_WORLD,ErrCode,IERROR)
 249 #endif
 250             stop "SEVERE error in energy calculation"
 251           endif
 252         enddo ! iii
 253         if (first_call) then
 254           do ii=1,iend_conf-istart_conf+1
 255             do j=1,n_ene
 256               enetb_orig(ii,j,iprot)=enetb(ii,j,iprot)
 257             enddo
 258           enddo
 259           ii=0
 260           call x2w(nvarr,x_orig)
 261 #ifdef DEBUG
 262           write (iout,*) "x,xorig"
 263           do k=1,nvarr
 264             write (iout,'(i5,2f10.5)') k,x(k),x_orig(k)
 265           enddo
 266 #endif
 267           do iii=istart_conf,iend_conf
 268             ii=ii+1
 269             call restore_ccoords(iprot,ii)
 270             call int_from_cart1(.false.)
 271             call etotal(energia(0))
 272 #ifdef DEBUG
 273             write (iout,*) "Conformation:",iii,ii
 274             write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 275             write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 276             write (iout,'(8f10.4)') (vbld(k),k=2,nres)
 277             write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
 278             write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 279             write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 280             write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 281             write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 282             call enerprint(energia(0))
 283 #endif
 284             do j=1,n_ene
 285               enetb_oorig(ii,j,iprot)=energia(j)
 286             enddo
 287 #ifdef DEBUG
 288             write (iout,'(2i5,20(1pe12.4))') iii,ii,
 289      &      (energia(j),j=1,n_ene),energia(0)
 290             write (iout,'(2i5,20(1pe12.4))') iii,ii,
 291      &      (enetb(ii,j,iprot),j=1,n_ene)
 292             call flush(iout)
 293 #endif
 294             if (energia(0).ge.1.0d99) then
 295               write (iout,*) "CHUJ NASTAPIL in energy evaluation for",
 296      &   " point",i,". Probably NaNs in some of the energy components."
 297               write (iout,*) "The components of the energy are:"
 298               call enerprint(energia(0))
 299               write (iout,*) "Calculation terminated at this point.",
 300      &         " Check the database of conformations"
 301 #ifdef MPI
 302               call MPI_Abort(MPI_COMM_WORLD,ErrCode,IERROR)
 303 #endif
 304               stop "SEVERE error in energy calculation"
 305             endif
 306           enddo ! iii
 307           write (iout,*) "MAKE_LIST Callig x2w"
 308           call flush(iout)
 309           call x2w(nvarr,x)
 310           write (iout,*) "After x2w"
 311           call flush(iout)
 312         endif
 313         write (iout,*) "make_list: calling dawrite_ene"
 314         write (iout,*) "istart_conf",istart_conf,
 315      &    " iend_conf",iend_conf
 316         call dawrite_ene(iprot,istart_conf,iend_conf,ientout)
 317 #ifdef MPI
 318 c Distribute energy components through ring
 319         call MPI_Barrier(WHAM_COMM,IERROR)
 320         write (iout,*) "Processes synchronized in make_list"
 321         call flush(iout)
 322         msg_out(1)= 5*me1+1000*ipass_conf+1
 323         msg_out(2)= 5*me1+1000*ipass_conf+2
 324         msg_out(3)= 5*me1+1000*ipass_conf+3
 325         msg_out(4)= 5*me1+1000*ipass_conf+4
 326         msg_out(5)= 5*me1+1000*ipass_conf+5
 327         do iii=1,Nprocs-1
 328 c Send the current energy tables to the right neighbor
 329 c Receive the energy tables produced by processor kkk from the left neighbor
 330           kkk = mod(me1-iii+NProcs,Nprocs)
 331           msg_in(1)= 5*kkk+1000*ipass_conf+1
 332           msg_in(2)= 5*kkk+1000*ipass_conf+2
 333           msg_in(3)= 5*kkk+1000*ipass_conf+3
 334           msg_in(4)= 5*kkk+1000*ipass_conf+4
 335           msg_in(5)= 5*kkk+1000*ipass_conf+5
 336           write (iout,*) "me1",me1," iii",iii," Previous",Previous,
 337      &     " Next",Next," kkk",kkk
 338           write (iout,*) "msg_in",msg_in
 339           write (iout,*) "msg_out",msg_out
 340           call flush(iout)
 341           write (iout,*) "Processor",me1," Start Send and receive"
 342           call flush(iout)
 343           call MPI_Send(istart_conf,1,MPI_INTEGER,Next,msg_out(1),
 344      &     WHAM_COMM,IERROR)
 345           write (iout,*) "Send",msg_out(1)," complete"
 346           call flush(iout)
 347           call MPI_Recv(istart_conf,1,MPI_INTEGER,Previous,
 348      &     msg_in(1),WHAM_COMM,STATUS(1,6),IERROR)
 349           write (iout,*) "Recv",msg_in(1)," complete"
 350           call flush(iout)
 351           call MPI_Send(iend_conf,1,MPI_INTEGER,Next,msg_out(2),
 352      &     WHAM_COMM,IERROR)
 353           write (iout,*) "Send",msg_out(2)," complete"
 354           call flush(iout)
 355           call MPI_Recv(iend_conf,1,MPI_INTEGER,Previous,
 356      &     msg_in(2),WHAM_COMM,STATUS(1,7),IERROR)
 357           write (iout,*) "Recv",msg_in(2)," complete"
 358           call flush(iout)
 359           call MPI_Buffer_Attach(buffer(1),8*(2*maxstr_proc*n_ene+800),
 360      &     IERROR)
 361           call MPI_BSend(enetb(1,1,iprot),maxstr_proc*n_ene,
 362      &    MPI_DOUBLE_PRECISION,Next,msg_out(3),
 363      &     WHAM_COMM,IERROR)
 364           write (iout,*) "Send",msg_out(3)," complete (enetb)"
 365           call flush(iout)
 366           call MPI_Recv(enetb(1,1,iprot),maxstr_proc*n_ene,
 367      &    MPI_DOUBLE_PRECISION,Previous,msg_in(3),WHAM_COMM,
 368      &     STATUS(1,8),IERROR)
 369           write (iout,*) "Recv",msg_in(3)," complete (enetb)"
 370           call flush(iout)
 371           call MPI_Buffer_Detach(address,size,IERROR)
 372 c          write (iout,*) "MPI_Buffer_Detach complete (enetb)"
 373 c          call flush(iout)
 374           call MPI_Buffer_Attach(buffer(1),8*(2*maxstr_proc*nntyp+800),
 375      &     IERROR)
 376 c          write (iout,*) "MPI_Buffer_Attach complete (eneps)"
 377 c          call flush(iout)
 378           call MPI_BSend(eneps(1,1,1,iprot),2*maxstr_proc*nntyp,
 379      &     MPI_DOUBLE_PRECISION,Next,msg_out(4),
 380      &     WHAM_COMM,IERROR)
 381           write (iout,*) "Send",msg_out(4)," complete (eneps)"
 382           call flush(iout)
 383           call MPI_Recv(eneps(1,1,1,iprot),2*maxstr_proc*nntyp,
 384      &    MPI_DOUBLE_PRECISION,Previous,msg_in(4),WHAM_COMM,
 385      &     STATUS(1,9),IERROR)
 386           write (iout,*) "Recv",msg_in(4)," complete (eneps)"
 387           call flush(iout)
 388           call MPI_Buffer_Detach(address,size,IERROR)
 389           call MPI_Buffer_Attach(buffer(1),8*(2*maxstr_proc*maxnatlike
 390      &     +800),IERROR)
 391           call MPI_BSend(nu(1,1,1,iprot),
 392      &    maxstr_proc*maxnatlike*maxdimnat,
 393      &    MPI_DOUBLE_PRECISION,Next,msg_out(5),
 394      &     WHAM_COMM,IERROR)
 395           write (iout,*) "Send",msg_out(5)," complete (nu)"
 396           call flush(iout)
 397           call MPI_Recv(nu(1,1,1,iprot),
 398      &    maxstr_proc*maxnatlike*maxdimnat,
 399      &    MPI_DOUBLE_PRECISION,Previous,msg_in(5),WHAM_COMM,
 400      &     STATUS(1,10),IERROR)
 401           write (iout,*) "Recv",msg_in(5)," complete (nu)"
 402           call flush(iout)
 403           call MPI_Buffer_Detach(address,size,IERROR)
 404           write (iout,*) "Send and receive complete"
 405           call flush(iout)
 406           write (iout,*) "Processor",me1," calling dawrite_ene",
 407      &     " istart_conf",istart_conf," iend_conf",iend_conf
 408           call flush(iout)
 409           if (first_call) then
 410 c            write (iout,*) "assignment of enetb_orig"
 411             do ii=1,iend_conf-istart_conf+1
 412               do j=1,n_ene
 413                 enetb_orig(ii,j,iprot)=enetb(ii,j,iprot)
 414               enddo
 415 c              write (iout,'(i5,20f8.2)')
 416 c     &         ii,(enetb_orig(ii,j,iprot),j=1,n_ene)
 417             enddo
 418           endif
 419           call dawrite_ene(iprot,istart_conf,iend_conf,ientout)
 420           do k=1,5
 421             msg_out(k)=msg_in(k)
 422           enddo
 423         enddo
 424 #endif
 425       endif
 426       enddo ! i
 427       if (.not.init_ene .and. mod_fourier(nloctyp).eq.0
 428      &  .and. .not. mod_elec .and. .not. mod_scp) then
 429         close (ientin)
 430       else
 431         close (icbase)
 432         close (ientout)
 433       endif
 434
 435       ENDDO ! iprot
 436       init_ene=.false.
 437 c Lowest free energies of structural classes
 438       DO IPROT=1,NPROT
 439
 440
 441       IF (NCHUNK_CONF(IPROT).EQ.1) THEN
 442
 443 #ifdef MPI
 444       do i=1,ntot_work(iprot)
 445         i2ii(i,iprot)=0
 446       enddo
 447       ii=0
 448       do i=indstart(me1,iprot),indend(me1,iprot)
 449         ii=ii+1
 450         i2ii(i,iprot)=ii
 451       enddo
 452       istart_conf=indstart(me1,iprot)
 453       iend_conf=indend(me1,iprot)
 454 #else
 455       do i=1,ntot_work(iprot)
 456         i2ii(i,iprot)=i
 457       endif
 458       istart_conf=1
 459       iend_conf=ntot_work(iprot)
 460 #endif
 461 #ifdef DEBUG
 462       write (iout,*) "i2ii at make_list"
 463       do i=1,ntot_work(iprot)
 464         write (iout,*) "i",i," i2ii",i2ii(i,iprot)
 465       enddo
 466       call flush(iout)
 467 #endif
 468       open (ientin,file=benefiles(iprot),status="old",
 469      &    form="unformatted",access="direct",recl=lenrec_ene(iprot))
 470       call daread_ene(iprot,istart_conf,iend_conf)
 471       call emin_search(iprot)
 472
 473       ELSE
 474
 475       open (ientin,file=benefiles(iprot),status="old",
 476      &    form="unformatted",access="direct",recl=lenrec_ene(iprot))
 477       ipass_conf=0
 478 #ifdef MPI
 479       do istart_conf=indstart(me1,iprot),indend(me1,iprot),maxstr_proc
 480         iend_conf=min0(istart_conf+maxstr_proc-1,indend(me1,iprot))
 481 #else
 482       do istart_conf=1,ntot_work(iprot),maxstr_proc
 483         iend_conf=min0(istart_conf+maxstr_proc-1,ntot_work(iprot))
 484 #endif
 485 c
 486 c Read the chunk of energies and derivatives off a DA scratchfile.
 487 c
 488         ipass_conf=ipass_conf+1
 489         do i=1,ntot_work(iprot)
 490           i2ii(i,iprot)=0
 491         enddo
 492         ii=0
 493         do i=istart_conf,iend_conf
 494           ii=ii+1
 495           i2ii(i,iprot)=ii
 496         enddo
 497 #ifdef DEBUG
 498         write (iout,*) "ipass_conf",ipass_conf,
 499      &    " istart_conf",istart_conf," iend_conf",iend_conf
 500         do i=1,ntot_work(iprot)
 501           write (iout,*) "i",i," i2ii",i2ii(i,iprot)
 502         enddo
 503         call flush(iout)
 504 #endif
 505         call daread_ene(iprot,istart_conf,iend_conf)
 506         call emin_search(iprot)
 507       enddo
 508
 509       close(ientin)
 510       ENDIF
 511
 512       ENDDO
 513 #ifdef MPI
 514 c Complete the calculation of the lowest energies over all classes and
 515 c distribute the values to all procs
 516       do iprot=1,nprot
 517         do ibatch=1,natlike(iprot)+2
 518 #ifdef DEBUG
 519           do ib=1,nbeta(ibatch,iprot)
 520             write (iout,'(7hELOWEST,3i3,f15.3,i12)') iprot,ibatch,ib,
 521      &        elowest(ib,ibatch,iprot),ind_lowest(ib,ibatch,iprot)
 522           enddo
 523 #endif
 524           do ib=1,nbeta(ibatch,iprot)
 525             elowest_aux(1,ib)=elowest(ib,ibatch,iprot)
 526             elowest_aux(2,ib)=ind_lowest(ib,ibatch,iprot)
 527           enddo
 528           call MPI_Allreduce(elowest_aux(1,1),elowest_t(1,1),
 529      &      nbeta(ibatch,iprot),
 530      &      MPI_2DOUBLE_PRECISION, MPI_MINLOC, Comm1, IERROR)
 531 #ifdef DEBUG
 532           do ib=1,nbeta(ibatch,iprot)
 533             write (iout,*) "beta=",betaT(ib,ibatch,iprot)
 534             write (iout,'(9helowest_t,10f15.3)')
 535      &        elowest_t(1,ib),elowest_t(2,ib)
 536           enddo
 537           write (iout,*) "Processor",me,me1," finished MPI_Reduce: 2"
 538 #endif
 539           do ib=1,nbeta(ibatch,iprot)
 540             elowest(ib,ibatch,iprot)=elowest_t(1,ib)
 541             ind_lowest(ib,ibatch,iprot)=elowest_t(2,ib)
 542           enddo
 543         enddo ! ibatc
 544       enddo ! iprot
 545       do iprot=1,nprot
 546         do ibatch=1,natlike(iprot)+2
 547           do ib=1,nbeta(ibatch,iprot)
 548             write (iout,*) "iprot",iprot," ibatch",ibatch," ib",ib,
 549      &         " elowest",elowest(ib,ibatch,iprot)
 550           enddo
 551         enddo
 552       enddo
 553 c
 554 c Allgather to provide all energies to all processors
 555 c
 556       do iprot=1,nprot
 557         do i=1,scount(me1,iprot)
 558           e_total_(i)=e_total(indstart(me1,iprot)+i-1,iprot)
 559         enddo
 560         call MPI_Allgatherv(e_total_(1),
 561      &     scount(me1,iprot),MPI_DOUBLE_PRECISION,e_total(1,iprot),
 562      &     scount(0,iprot),idispl(0,iprot),MPI_DOUBLE_PRECISION,
 563      &     Comm1, IERROR)
 564 c        call MPI_Allgatherv(e_total(indstart(me1,iprot),iprot),
 565 c     &     scount(me1,iprot),MPI_DOUBLE_PRECISION,e_total(1,iprot),
 566 c     &     scount(0,iprot),idispl(0,iprot),MPI_DOUBLE_PRECISION,
 567 c     &     Comm1, IERROR)
 568       enddo
 569 #endif
 570 c
 571 c Now determine which conformations will enter the database.
 572 c
 573       do iprot=1,nprot
 574         call restore_molinfo(iprot)
 575 c Clear the list of conformations
 576         do i=1,min0(ntot(iprot),maxstr)
 577           list_conf(i,iprot)=0
 578         enddo
 579         do i=1,ntot(iprot)
 580           lflag(i)=.false.
 581         enddo
 582 c Make the list of conformations based on energy cut-off.
 583         nn=0
 584 #ifdef DEBUG
 585         write (iout,*) "iprot",iprot," ibatch",ibatch," betmin",
 586      &    betmin(ibatch,iprot)
 587 #endif
 588 #ifdef DEBUG
 589         write (iout,*) "e_lowb",e_lowb(iprot)
 590         write (iout,*) "t_lowb",t_lowb(iprot)
 591 #endif
 592         do ibatch=1,natlike(iprot)+2
 593         do i=1,ntot(iprot)
 594           jj = i2ii(i,iprot)
 595 #ifdef MPI
 596 c              write (iout,*) "i",i," ii",ii," indstart",
 597 c     &         indstart(me1,iprot)," indend",indend(me1,iprot)
 598           if (i.ge.indstart(me1,iprot).and.i.le.indend(me1,iprot))
 599      &    then
 600 #endif
 601 c              write (iout,*) "i",i," ii",ii," kbatch",kbatch(i,iprot),
 602 c     &          " flag",lflag(i)
 603           if (.not.lflag(i)) then
 604 c            if (eini(i,iprot).lt.e_lowb(iprot) .or.
 605 c     &          entfac(i,iprot).lt.t_lowb(iprot)) then
 606 c#ifdef DEBUG
 607 c              write (iout,*) "Conformation",i," eini",eini(i,iprot),
 608 c     &           " entfac",entfac(i,iprot)," e_lowb",
 609 c     &         e_lowb(iprot),
 610 c     &           " t_lowb",t_lowb(iprot)
 611 c#endif
 612 c              lflag(i)=.true.
 613 c              goto 122
 614 c            endif
 615             do ib=1,nbeta(ibatch,iprot)
 616               dene=betaT(ib,ibatch,iprot)*(e_total(i,iprot)
 617      &          -elowest(ib,ibatch,iprot))+entfac(i,iprot)
 618 #ifdef DEBUG
 619               write (iout,*) "beta",betaT(ib,ibatch,iprot),
 620      &           " i",i," e_total",
 621      &        e_total(i,iprot),
 622      &         " elowest",elowest(ib,ibatch,iprot)," dene",dene,
 623      &         " enecut",enecut(iprot)
 624 #endif
 625               if (dene.lt.enecut(iprot)) then
 626                 nn=nn+1
 627                 list_conf(nn,iprot)=i
 628                 lflag(i)=.true.
 629                 goto 122
 630               endif
 631             enddo
 632   122       continue
 633           endif
 634 #ifdef MPI
 635           endif
 636 #endif
 637         enddo ! j
 638         enddo ! ibatch
 639         ntot_work(iprot)=nn
 640         if (nn.gt.maxstr) then
 641           write (iout,*) "Error - after applying cutoff the number",
 642      &     " of conformations for protein ",i," exceeds MAXSTR:",
 643      &     nn,maxstr
 644           write (iout,*) "The calculation is terminating."
 645           call flush(iout)
 646 #ifdef MPI
 647           call MPI_Finalize(ierror)
 648 #endif
 649           stop
 650         endif
 651         call imysort(ntot_work(iprot),list_conf(1,iprot),ipermut)
 652         write (iout,*) "Protein",iprot,ntot_work(iprot),
 653      &   " conformations within scaled energy cut-off=",enecut(iprot),
 654      &   " found at processor",me
 655 #ifdef MPI
 656 c
 657 c All workers get the complete list of conformations.
 658 c
 659         call MPI_Allgather(ntot_work(iprot),1,MPI_INTEGER,
 660      &    scount(0,iprot),1,MPI_INTEGER,Comm1,IERROR)
 661         idispl(0,iprot)=0
 662         do i=1,nprocs1-1
 663           idispl(i,iprot)=idispl(i-1,iprot)+scount(i-1,iprot)
 664         enddo
 665 #ifdef DEBUG
 666         write (iout,*) "Protein",iprot," Scount and Idispl"
 667         do i=0,nprocs1-1
 668           write (iout,*) i,scount(i,iprot),idispl(i,iprot)
 669         enddo
 670         write (iout,*) "Protein",i,
 671      &    " local list of conformations of processor",me
 672         do i=1,ntot_work(iprot)
 673           write(iout,*) i,list_conf(i,iprot)
 674         enddo
 675         write (iout,*) "Before REDUCE: ntot_work",ntot_work(iprot)
 676         call flush(iout)
 677 #endif
 678         call MPI_Allreduce(ntot_work(iprot),nn,1,MPI_INTEGER,MPI_SUM,
 679      &    Comm1,IERROR)
 680         ntot_work(iprot)=nn
 681 #ifdef DEBUG
 682         write (iout,*) "After REDUCE: ntot_work",ntot_work(iprot)
 683         call flush(iout)
 684 #endif
 685         call MPI_Allgatherv(list_conf(1,iprot),
 686      &    scount(me1,iprot),MPI_INTEGER,list_conf_(1,iprot),
 687      &    scount(0,iprot),idispl(0,iprot),MPI_INTEGER,Comm1,IERROR)
 688         do i=1,ntot_work(iprot)
 689           list_conf(i,iprot)=list_conf_(i,iprot)
 690         enddo
 691 #ifdef DEBUG
 692         write (iout,*) "Protein",i,
 693      &    " global list of conformations of processor",me
 694         do i=1,ntot_work(iprot)
 695           write(iout,'(2i5,e15.5,33f7.3)')i,list_conf(i,iprot),
 696      &      e_total(list_conf(i,iprot),iprot)
 697 c     &      ,(nu(k,i,iprot),k=1,natlike(iprot))
 698         enddo
 699         call flush(iout)
 700 #endif
 701 #endif
 702 c
 703 c Construct the mapping of the new list to the original numbers of
 704 c conformations.
 705 c
 706         do i=1,ntot(iprot)
 707           tsil(i,iprot)=0
 708         enddo
 709         do i=1,ntot_work(iprot)
 710           tsil(list_conf(i,iprot),iprot)=i
 711         enddo
 712 #ifdef DEBUG
 713         write (iout,*) "Protein",i," List-to-conformation mapping"
 714         do i=1,ntot(iprot)
 715           write(iout,*) i,tsil(i,iprot)
 716         enddo
 717 #endif
 718       enddo       ! iprot
 719 c
 720 c Divide the work again based on the current lists of conformations
 721 c
 722       call work_partition(.true.)
 723 c
 724 c If the conformations fit into memory, read them off a DA scratchfile.
 725 c
 726       do iprot=1,nprot
 727         call restore_molinfo(iprot)
 728 #ifdef MPI
 729         nchunk_conf(iprot)=iroof(scount(me1,iprot),maxstr_proc)
 730 #else
 731         nchunk_conf(iprot)=iroof(ntot_work(iprot),maxstr_proc)
 732 #endif
 733         if (nchunk_conf(iprot).eq.1) then
 734           write (iout,*) "Protein",iprot,
 735      &     " in-memory storage of conformations."
 736           if (init_ene .or. mod_fourier(nloctyp).gt.0
 737      &      .or. mod_elec .or. mod_scp) then
 738             open (icbase,file=bprotfiles(iprot),status="old",
 739      &      form="unformatted",access="direct",recl=lenrec(iprot))
 740 #ifdef MPI
 741             call daread_ccoords(iprot,indstart(me1,iprot),
 742      &        indend(me1,iprot))
 743 #else
 744             call daread_ccoords(iprot,1,ntot_work(iprot))
 745 #endif
 746             close(icbase)
 747           else
 748             open (ientin,file=benefiles(iprot),status="old",
 749      &        form="unformatted",access="direct",recl=lenrec_ene(iprot))
 750 #ifdef MPI
 751             call daread_ene(iprot,indstart(me1,iprot),
 752      &        indend(me1,iprot))
 753 #else
 754             call daread_ene(iprot,1,ntot_work(iprot))
 755 #endif
 756             close(ientin)
 757             open (icbase,file=bprotfiles(iprot),status="old",
 758      &      form="unformatted",access="direct",recl=lenrec(iprot))
 759 #ifdef MPI
 760             call daread_ccoords(iprot,indstart(me1,iprot),
 761      &        indend(me1,iprot))
 762 #else
 763             call daread_ccoords(iprot,1,ntot_work(iprot))
 764 #endif
 765             close(icbase)
 766           endif
 767 #ifdef DEBUG
 768           write (iout,*) "Protein",i,
 769      &    " global list of conformations of processor",me
 770           do i=1,ntot_work(iprot)
 771             write(iout,'(2i5,e15.5,33f7.3)')i,list_conf(i,iprot),
 772      &      e_total(list_conf(i,iprot),iprot)
 773           enddo
 774 #endif
 775         else
 776             write (iout,*) "Protein",iprot,
 777      &     " off-memory storage of conformations; ",
 778      &     "energy will be evaluated in",nchunk_conf(iprot)," passes."
 779         endif
 780       enddo
 781       do i=1,n_ene
 782         ww_orig(i)=ww(i)
 783       enddo
 784       do iprot=1,nprot
 785 #ifdef DEBUG
 786         write (iout,*) "E_TOTAL and ETOT_ORIG of protein",iprot
 787 #endif
 788         do i=1,ntot_work(iprot)
 789           etot_orig(i,iprot)=e_total(list_conf(i,iprot),iprot)
 790 #ifdef DEBUG
 791           write (iout,*) i,list_conf(i,iprot),
 792      &     e_total(list_conf(i,iprot),iprot),etot_orig(i,iprot)
 793 #endif
 794         enddo
 795         do ibatch=1,natlike(iprot)+2
 796         do ib=1,nbeta(ibatch,iprot)
 797           emini = elowest(ib,ibatch,iprot)
 798           if (elowest(ib,ibatch,iprot) .lt. emini)
 799      &        emini = elowest(ib,ibatch,iprot)
 800           emin_orig(ib,ibatch,iprot)=emini
 801         enddo
 802         enddo
 803       enddo
 804 #ifdef MPI
 805       if (me1 .eq. Master) call write_conf_count
 806 #else
 807       call write_conf_count
 808 #endif
 809 #ifdef DEBUG
 810       write (iout,*) "ELOWEST at the end of MAKE_LIST"
 811       do iprot=1,nprot
 812         do ibatch=1,natlike(iprot)+2
 813           do ib=1,nbeta(ibatch,iprot)
 814             write (iout,*) "iprot",iprot," ibatch",ibatch," ib",ib,
 815      &         " elowest",elowest(ib,ibatch,iprot)
 816           enddo
 817         enddo
 818       enddo
 819 #endif
 820       tcpu_fin = tcpu() - tcpu_ini
 821       write (iout,*) "Time for creating list of conformations",tcpu_fin
 822       call flush(iout)
 823       t_func = t_func + tcpu_fin
 824       return
 825       end
 826 c----------------------------------------------------------------------------
 827       subroutine emin_search(iprot)
 828       implicit none
 829       include "DIMENSIONS"
 830       include "DIMENSIONS.ZSCOPT"
 831 #ifdef MPI
 832       include "mpif.h"
 833       integer IERROR,ErrCode,Status(MPI_STATUS_SIZE,10)
 834       integer req(10),msg_in(5),msg_out(5),address,size
 835       character*1 buffer(8*(2*maxstr_proc*nntyp+8000))
 836       include "COMMON.MPI"
 837 #endif
 838       include "COMMON.WEIGHTS"
 839       include "COMMON.WEIGHTDER"
 840       include "COMMON.COMPAR"
 841       include "COMMON.ENERGIES"
 842       include "COMMON.IOUNITS"
 843       include "COMMON.VMCPAR"
 844       include "COMMON.NAMES"
 845       include "COMMON.INTERACT"
 846       include "COMMON.TIME1"
 847       include "COMMON.CHAIN"
 848       include "COMMON.PROTFILES"
 849       include "COMMON.VAR"
 850       include "COMMON.GEO"
 851       include "COMMON.CLASSES"
 852 C Define local variables
 853       integer i,ii,iii,kkk,jj,j,k,kk,l,iprot,ib,ibatch,nn
 854       integer ipass_conf,istart_conf,iend_conf,Previous,Next
 855       double precision energia(0:max_ene)
 856       double precision etoti,elowesti,dene
 857       double precision tcpu_ini,tcpu_fin,tcpu
 858       double precision etot_aux,enepsjk,
 859      &  emini,elowest_aux(2,maxT)
 860       integer iroof,icant
 861       external iroof,icant
 862       logical lprn
 863
 864       do ibatch=1,natlike(iprot)+2
 865         do ib=1,nbeta(ibatch,iprot)
 866           elowest(ib,ibatch,iprot)=1.0d20
 867         enddo
 868       enddo
 869       do ibatch=1,natlike(iprot)+2
 870         do k=1,ntot(iprot)
 871         jj=i2ii(k,iprot)
 872 #ifdef MPI
 873         if (jj.gt.0) then
 874 #endif
 875           do ib=1,nbeta(ibatch,iprot)
 876             etoti=0.0d0
 877             do kk=1,n_ene
 878               etoti=etoti+ww(kk)*enetb(jj,kk,iprot)
 879      &          *escal(kk,ib,ibatch,iprot)
 880             enddo
 881             if (ib.eq.1 .and. etoti.lt.elowest_ent(1,ibatch,iprot))
 882      &      then
 883               elowest_ent(1,ibatch,iprot)=etoti
 884               elowest_ent(2,ibatch,iprot)=entfac(k,iprot)
 885             endif
 886 c            if (ib.gt.1)
 887 c     &      etoti=etoti+entfac(k,iprot)/betaT(ib,ibatch,iprot)
 888             etoti=etoti+entfac(k,iprot)/betaT(ib,ibatch,iprot)
 889             if (etoti.lt.elowest(ib,ibatch,iprot)) then
 890               elowest(ib,ibatch,iprot)=etoti
 891               ind_lowest(ib,ibatch,iprot)=k
 892             endif
 893 c              write (iout,*) ib,betaT(ib,ibatch,iprot),etoti,
 894 c     &          entfac(k,iprot)
 895 #ifdef DEBUG
 896             write (iout,'(2i5,2e15.5,f8.3)') k,jj,
 897      &      etoti,elowest(ib,ibatch,iprot),betaT(ib,ibatch,iprot)
 898 #endif
 899           enddo ! ib
 900 #ifdef DEBUG
 901           write (iout,'(2i5,20f8.2)') j,jj,(enetb(jj,kk,iprot),
 902      &         kk=1,n_ene)
 903 #endif
 904 #ifdef MPI
 905           endif
 906 #endif
 907         enddo ! k
 908       enddo ! ibatch
 909       return
 910       end