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