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