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