subroutine make_list_MD(lprn)
      implicit none
      include "DIMENSIONS"
      include "DIMENSIONS.ZSCOPT"
#ifdef MPI
      include "mpif.h"
      integer IERROR,ErrCode,Status(MPI_STATUS_SIZE,10)
      integer req(10),msg_in(5),msg_out(5),address,bufsize
      character*1 buffer(8*(maxstr_proc*maxres6*max_ene+8000))
      include "COMMON.MPI"
#endif
      include "COMMON.WEIGHTS"
      include "COMMON.WEIGHTDER"
      include "COMMON.ENERGIES"
      include "COMMON.IOUNITS"
      include "COMMON.VMCPAR"
      include "COMMON.NAMES"
      include "COMMON.INTERACT"
      include "COMMON.TIME1"
      include "COMMON.CHAIN"
      include "COMMON.PROTFILES"
      include "COMMON.VAR"
      include "COMMON.GEO"
      include "COMMON.OPTIM"
      include "COMMON.CLASSES"
      include "COMMON.COMPAR"
      include "COMMON.TORSION"
      include "COMMON.FMATCH"
      include "COMMON.DERIV"
      include "COMMON.PROTNAME"
C Define local variables
      integer i,ii,iii,ibatch,kkk,jj,j,k,kk,l,iprot,ib,nn
      integer ipass_conf,istart_conf,iend_conf,Previous,Next
      double precision energia(0:max_ene)
      double precision tcpu_ini,tcpu_fin,tcpu
      integer iroof,icant
      external iroof,icant
      logical lprn,first_call
      logical*1 lflag(maxstr)
      integer list_conf_MD_(maxstr,maxprot)
      double precision ftune_eps
      integer ilen
      external ilen
#ifdef MPI
c      double precision e_total_(maxstr_proc)
#endif
      write (iout,*) "Making the worklist of MD conformations."
      call flush(iout)
      calc_grad=.true.
      tcpu_ini = tcpu()
      do iprot=1,nprot
        do i=1,nconf_forc(iprot)
          list_conf_MD(i,iprot)=i
        enddo
        ntot_work_MD(iprot)=nconf_forc(iprot)
        write (iout,*) "iprot",iprot," ntot_work_MD",ntot_work_MD(iprot)
        call flush(iout)
      enddo
#ifdef MPI
c
c Divide the whole database between processors
c
      Previous = me1-1
      Next = me1+1
      if (Previous.lt.0) Previous = Nprocs-1
      if (Next.ge.Nprocs) Next = 0
      write (iout,*) "Make_list_MD: first call of work_partition"
      call flush(iout)
      call work_partition_MD(lprn)
      write (iout,*) "Make_list_MD: end first call of work_partition"
      call flush(iout)
#endif
c
c Loop over proteins
c
      DO iprot=1,nprot

       if (.not.fmatch(iprot)) cycle
       call restore_molinfo(iprot)
c Loop over the conformations of protein IPROT assigned to the current processor. 
c The conformations are read off a DA scratchfile and processed in passes, each
c of which requires no more than MAXSTR_PROC conformations to be stored in memory
c simultaneously.
c
      write (iout,*) "iprot",iprot
      write (iout,*) "Opening ",bprotfiles_MD(iprot)
      call flush(iout)
      open (icbase,file=bprotfiles_MD(iprot),status="old",
     &    form="unformatted",access="direct",recl=lenrec_MD(iprot))
      write (iout,*) "Opening ",bforcefiles(iprot)
      call flush(iout)
      if (.not.mod_other_params)
     &  open (ientout,file=bforcefiles(iprot),status="unknown",
     &    form="unformatted",access="direct",recl=lenrec_forces(iprot))
      write (iout,*) bforcefiles(iprot)," opened"

#ifdef MPI
      nchunk_conf_MD(iprot) = iroof(scount_MD(me1,iprot),maxstr_proc)
      write (iout,*)"Protein",iprot," from MD energy evaluation in",
     &   nchunk_conf_MD(iprot)," passes."
      call flush(iout)
      ipass_conf=0
      jj=0
      nn=0
      do i=indstart_MD(me1,iprot),indend_MD(me1,iprot),maxstr_proc
      ipass_conf=ipass_conf+1
      write (iout,*) "MAKE_LIST_MD: Pass",ipass_conf
      istart_conf=i
      iend_conf=min0(i+maxstr_proc-1,indend_MD(me1,iprot))
      write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
#else
      nchunk_ene_MD(iprot) = iroof(ntot_MD(iprot),maxstr)
      nchunk_conf_MD(iprot) = iroof(ntot_MD(iprot),maxstr_proc)
      write (iout,*)"Protein",iprot," energy evaluation in",
     &   nchunk_conf_MD," passes."
      ipass_conf=0

      do i=1,ntot_MD(iprot),maxstr_proc

      ipass_conf=ipass_conf+1
      write (iout,*) "MAKE_LIST: Pass",ipass_conf_MD
      istart_conf=i
      iend_conf=min0(i+maxstr_proc-1,ntot_MD(iprot))
#endif
      ii=0
c Read the chunk of conformations off a DA scratchfile.
c
      call daread_MDcoords(iprot,istart_conf,iend_conf)
c
c Compute the energies of the conformations currently in memory and compute
c the lowest energies.
c
      do iii=istart_conf,iend_conf
        ii=ii+1
        call restore_MDcoords(iprot,ii)
        call int_from_cart1(.false.)
#ifdef DEBUG
        write (iout,*) "Makelist_MD: Before etotal",iii,i
        call flush(iout)
#endif
        call zerograd
        call etotal(energia(0))
        call cartgrad
#ifdef DEBUG
        write (iout,*) "After etotal",iii
        call flush(iout)
        call enerprint(energia(0))
c          write (iout,'(i5,16(1pe12.4))') i,
c     &    (energia(j),j=1,n_ene),energia(0)
        call flush(iout)
#endif
#ifdef DEBUG
        write (iout,*) "Conformation:",iii
        write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
        write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
        write (iout,'(8f10.4)') (vbld(k),k=2,nres)
        write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
        write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
        write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
        write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
        write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
        call enerprint(energia(0))
#endif
c        e_total_MD(iii,iprot)=energia(0)
        do k=1,nres
          do l=1,3
            do j=1,n_ene
              forctb(j,l,k,ii,iprot)=-gcompon(j,l,k)
            enddo
          enddo
        enddo
        kk=nres
        do k=nnt,nct
          if (itype(k).eq.10 .or. itype(k).eq.ntyp1) cycle
          kk=kk+1
          do l=1,3
            do j=1,n_ene
              forctb(j,l,kk,ii,iprot)=-gcomponx(j,l,k)
            enddo
          enddo
        enddo
#ifdef DEBUG
        write (iout,'(i5,20(1pe12.4))') iii,
     &    (energia(j),j=1,n_ene),energia(0)
        call flush(iout)
#endif
        if (energia(0).ge.1.0d7) then
          write (iout,*) 
     &  "MAKE_LIST_MD: energy too high for protein",iprot,
     &  " point",iii,ii,", conformationn skipped."
          write (iout,*) "The components of the energy are:"
          call enerprint(energia(0))
          write (iout,*) "Conformation:",iii,ii
          write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
          write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
          write (iout,'(8f10.4)') (vbld(k),k=2,nres)
          write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
          write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
          write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
          write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
          write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
        else
          nn=nn+1     
          list_conf_MD_(nn,iprot)=iii
        endif
      enddo ! iii
C Change AL 12/30/2017
c
      write (iout,*) "mod_other_params ",mod_other_params
      if (.not. mod_other_params) then
        write (iout,*) "make_list_MD: calling dawrite_forces"
        write (iout,*) "istart_conf",istart_conf,
     &    " iend_conf",iend_conf

        call dawrite_forces(iprot,istart_conf,iend_conf,ientout)
c        write (iout,*) "Finish dawrite_forces"
c        call flush(iout)
#ifdef MPI
c Distribute force components through ring
c        write (iout,*) "Calling MPI_Barrier"
c        call flush(iout)
        call MPI_Barrier(WHAM_COMM,IERROR)
        write (iout,*) "Processes synchronized in make_list_MD"
        call flush(iout)
        msg_out(1)= 5*me1+1000*ipass_conf+6
	msg_out(2)= 5*me1+1000*ipass_conf+7
        msg_out(3)= 5*me1+1000*ipass_conf+8
        msg_out(4)= 5*me1+1000*ipass_conf+9
        msg_out(5)= 5*me1+1000*ipass_conf+10
        do iii=1,Nprocs-1
c Send the current force tables to the right neighbor
c Receive the force tables produced by processor kkk from the left neighbor
          kkk = mod(me1-iii+NProcs,Nprocs)
          msg_in(1)= 5*kkk+1000*ipass_conf+6
      	  msg_in(2)= 5*kkk+1000*ipass_conf+7
          msg_in(3)= 5*kkk+1000*ipass_conf+8
          msg_in(4)= 5*kkk+1000*ipass_conf+9
          msg_in(5)= 5*kkk+1000*ipass_conf+10
          write (iout,*) "me1",me1," iii",iii," Previous",Previous,
     &     " Next",Next," kkk",kkk
          write (iout,*) "msg_in",msg_in
          write (iout,*) "msg_out",msg_out
          call flush(iout)
          write (iout,*) "Processor",me1," Start Send and receive"
          call flush(iout)
          call MPI_Send(istart_conf,1,MPI_INTEGER,Next,msg_out(1),
     &     WHAM_COMM,IERROR)
          write (iout,*) "Send",msg_out(1)," complete"
          call flush(iout)
          call MPI_Recv(istart_conf,1,MPI_INTEGER,Previous,
     &     msg_in(1),WHAM_COMM,STATUS(1,6),IERROR)
          write (iout,*) "Recv",msg_in(1)," complete"
          call flush(iout)
          call MPI_Send(iend_conf,1,MPI_INTEGER,Next,msg_out(2),
     &     WHAM_COMM,IERROR)
          write (iout,*) "Send",msg_out(2)," complete"
          call flush(iout)
          call MPI_Recv(iend_conf,1,MPI_INTEGER,Previous,
     &     msg_in(2),WHAM_COMM,STATUS(1,7),IERROR)
          write (iout,*) "Recv",msg_in(2)," complete"
          call flush(iout)
          call MPI_Buffer_Attach(buffer(1),
     &     8*(scount_MD(Me1,iprot)*maxres6*max_ene+800),
     &     IERROR)
          call MPI_BSend(forctb(1,1,1,1,iprot),
     &          scount_MD(me1,iprot)*maxres6*max_ene,
     &          MPI_DOUBLE_PRECISION,Next,msg_out(3),
     &          WHAM_COMM,IERROR)
          write (iout,*) "Send",msg_out(3)," complete (forctb)"
          call flush(iout)
          call MPI_Recv(forctb(1,1,1,1,iprot),
     &          scount_MD(Previous,iprot)*maxres6*max_ene,
     &          MPI_DOUBLE_PRECISION,Previous,msg_in(3),WHAM_COMM,
     &          STATUS(1,8),IERROR)
          write (iout,*) "Recv",msg_in(3)," complete (forctb)"
          call flush(iout)
          call MPI_Buffer_Detach(address,bufsize,IERROR)
          write (iout,*) "Comm with proc",iii," istart_conf",
     &      istart_conf," iend_conf",iend_conf
          write (iout,*) "Calling dawrite_forces"
          call dawrite_forces(iprot,istart_conf,iend_conf,ientout)
          do k=1,5
            msg_out(k)=msg_in(k)
          enddo
        enddo
#endif
        if (.not.mod_other_params) close(ientout)
      endif

      enddo
      close (icbase)
      ntot_work_MD(iprot)=nn

      ENDDO ! iprot

c Divide the work again based on the current lists of conformations
      DO IPROT=1,NPROT
#ifdef DEBUG
       write (iout,*) "Processor",me," loop IPROT",iprot
       write (iout,*) "fmatch ",fmatch(iprot)
#endif
       if (.not.fmatch(iprot)) cycle
#ifdef MPI
c
c All workers get the complete list of conformations.
c
        call MPI_Allgather(ntot_work_MD(iprot),1,MPI_INTEGER,
     &    scount_MD(0,iprot),1,MPI_INTEGER,Comm1,IERROR)
        idispl_MD(0,iprot)=0
        do i=1,nprocs1-1
          idispl_MD(i,iprot)=idispl_MD(i-1,iprot)+scount_MD(i-1,iprot)
        enddo
#ifdef DEBUG
        write (iout,*) "Protein",iprot," MD Scount and Idispl"
        do i=0,nprocs1-1
          write (iout,*) i,scount_MD(i,iprot),idispl_MD(i,iprot)
        enddo
        write (iout,*) "Protein",iprot,
     &    " local list of MD conformations of processor",me
        do i=1,ntot_work_MD(iprot)
          write(iout,*) i,list_conf_MD(i,iprot)
        enddo
        write (iout,*) "Before REDUCE: ntot_work_MD",ntot_work_MD(iprot)
        call flush(iout)
#endif
        call MPI_Allreduce(ntot_work_MD(iprot),nn,1,MPI_INTEGER,MPI_SUM,
     &    Comm1,IERROR)
        ntot_work_MD(iprot)=nn
#ifdef DEBUG
        write (iout,*) "After REDUCE: ntot_work_MD",ntot_work_MD(iprot)
        call flush(iout)
#endif
        call MPI_Allgatherv(list_conf_MD_(1,iprot),
     &    scount_MD(me1,iprot),MPI_INTEGER,list_conf_MD(1,iprot),
     &   scount_MD(0,iprot),idispl_MD(0,iprot),MPI_INTEGER,Comm1,IERROR)
#ifdef DEBUG
        write (iout,*) "Protein",iprot,
     &    " global list of MD conformations of processor",me
        do i=1,ntot_work_MD(iprot)
          write(iout,'(2i5)')i,list_conf_MD(i,iprot)
c     &      ,(nu(k,i,iprot),k=1,natlike(iprot))
        enddo
        call flush(iout)
#endif
#else
        do i=1,ntot_work_MD(iprot)
          list_conf_MD(i,iprot)=list_conf_MD_(i,iprot)
        enddo
#endif
      ENDDO !  IPROT
c
      call work_partition_MD(.true.)
c
      do iprot=1,nprot
       if (.not.fmatch(iprot)) cycle
#ifdef MPI
        do i=1,ntot_work_MD(iprot)
          i2ii_MD(i,iprot)=0
        enddo
        ii=0
        do i=indstart_MD(me1,iprot),indend_MD(me1,iprot)
          ii=ii+1
          i2ii_MD(i,iprot)=ii
        enddo
#else
        do i=1,ntot_work_MD(iprot)
          i2ii_MD(i,iprot)=i
        endif
#endif
c
        tsil_MD=0
        do i=1,ntot_work_MD(iprot)
          tsil_MD(list_conf_MD(i,iprot),iprot)=i
        enddo
#ifdef DEBUG
        write (iout,*) "Protein",i," List-to-conformation mapping"
        do i=1,ntot_work_MD(iprot)
          write(iout,*) i,tsil_MD(i,iprot)
        enddo
#endif
      enddo       ! iprot

      write (iout,*)
      write (iout,*)
     &  "Numbers of MD conformations after applying the cutoff"
      write (iout,*)
      do iprot=1,nprot
        if (.not.fmatch(iprot)) cycle
        write (iout,'(a,2x,a,i10)') "Protein",
     &    protname(iprot)(:ilen(protname(iprot))),
     &    ntot_work_MD(iprot)
      enddo
c

      tcpu_fin = tcpu() - tcpu_ini
      write (iout,*) "Time for creating list of MD conformations",
     &  tcpu_fin
      call flush(iout)
      t_func = t_func + tcpu_fin
      return
      end