1 subroutine make_list(lprn,first_call,nvarr,x)
4 include "DIMENSIONS.ZSCOPT"
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))
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"
24 include "COMMON.OPTIM"
25 include "COMMON.CLASSES"
26 include "COMMON.COMPAR"
27 include "COMMON.TORSION"
28 C Define local variables
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)
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
47 double precision e_total_(maxstr_proc)
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
57 ntot_work(iprot)=ntot(iprot)
61 c Divide the whole database between processors
65 if (Previous.lt.0) Previous = Nprocs-1
66 if (Next.ge.Nprocs) Next = 0
67 call work_partition(lprn)
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)
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
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))
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))
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."
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
111 iend_conf=min0(i+maxstr_proc-1,indend(me1,iprot))
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."
118 do i=1,ntot(iprot),maxstr_proc
119 ipass_conf=ipass_conf+1
120 write (iout,*) "MAKE_LIST: Pass",ipass_conf
122 iend_conf=min0(i+maxstr_proc-1,ntot(iprot))
126 c Read the chunk of conformations off a DA scratchfile.
128 if (.not.init_ene .and. mod_fourier(nloctyp).eq.0
129 & .and. .not. mod_elec .and. .not. mod_scp) then
131 c If energy components have been pre-computed read them off a DA file.
133 call daread_ene(iprot,istart_conf,iend_conf)
134 do iii=istart_conf,iend_conf
138 enetb(ii,1,iprot)=0.0d0
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)
149 etot_aux=etot_aux+ww(j)*enetb(ii,j,iprot)
151 e_total(iii,iprot)=etot_aux
153 write (iout,'(i5,16(1pe12.4))') iii,
154 & (enetb(ii,j,iprot),j=1,n_ene),e_total(iii,iprot)
158 if (first_call .and. mod_side) then
159 write (iout,*) "Callig x2w"
161 call x2w(nvarr,x_orig)
162 write (iout,*) "After x2w"
165 do iii=istart_conf,iend_conf
167 enetb_oorig(ii,1,iprot)=0.0d0
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)
176 enetb_oorig(ii,j,iprot)=enetb(ii,j,iprot)
182 call daread_ccoords(iprot,istart_conf,iend_conf)
184 c Compute the energies of the conformations currently in memory and compute
185 c the lowest energies.
187 do iii=istart_conf,iend_conf
190 call restore_ccoords(iprot,ii)
191 call int_from_cart1(.false.)
193 write (iout,*) "Before etotal",iii,i
196 call etotal(energia(0))
198 write (iout,*) "After etotal",i
200 call enerprint(energia(0))
201 c write (iout,'(i5,16(1pe12.4))') i,
202 c & (energia(j),j=1,n_ene),energia(0)
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))
217 e_total(iii,iprot)=energia(0)
219 enetb(ii,j,iprot)=energia(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))
228 write (iout,'(i5,20(1pe12.4))') iii,
229 & (energia(j),j=1,n_ene),energia(0),eini(iii,iprot),
233 if (energia(0).ge.1.0d99) then
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"
251 call MPI_Abort(MPI_COMM_WORLD,ErrCode,IERROR)
253 stop "SEVERE error in energy calculation"
257 do ii=1,iend_conf-istart_conf+1
259 enetb_orig(ii,j,iprot)=enetb(ii,j,iprot)
263 call x2w(nvarr,x_orig)
265 write (iout,*) "x,xorig"
267 write (iout,'(i5,2f10.5)') k,x(k),x_orig(k)
270 do iii=istart_conf,iend_conf
272 call restore_ccoords(iprot,ii)
273 call int_from_cart1(.false.)
274 call etotal(energia(0))
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))
288 enetb_oorig(ii,j,iprot)=energia(j)
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)
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"
305 call MPI_Abort(MPI_COMM_WORLD,ErrCode,IERROR)
307 stop "SEVERE error in energy calculation"
310 write (iout,*) "MAKE_LIST Callig x2w"
313 write (iout,*) "After x2w"
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)
323 c Distribute energy components through ring
324 call MPI_Barrier(WHAM_COMM,IERROR)
325 write (iout,*) "Processes synchronized in make_list"
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
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
346 write (iout,*) "Processor",me1," Start Send and receive"
348 call MPI_Send(istart_conf,1,MPI_INTEGER,Next,msg_out(1),
350 write (iout,*) "Send",msg_out(1)," complete"
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"
356 call MPI_Send(iend_conf,1,MPI_INTEGER,Next,msg_out(2),
358 write (iout,*) "Send",msg_out(2)," complete"
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"
364 call MPI_Buffer_Attach(buffer(1),8*(2*maxstr_proc*n_ene+800),
366 call MPI_BSend(enetb(1,1,iprot),maxstr_proc*n_ene,
367 & MPI_DOUBLE_PRECISION,Next,msg_out(3),
369 write (iout,*) "Send",msg_out(3)," complete (enetb)"
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)"
376 call MPI_Buffer_Detach(address,size,IERROR)
377 c write (iout,*) "MPI_Buffer_Detach complete (enetb)"
379 call MPI_Buffer_Attach(buffer(1),8*(2*maxstr_proc*nntyp+800),
381 c write (iout,*) "MPI_Buffer_Attach complete (eneps)"
383 call MPI_BSend(eneps(1,1,1,iprot),2*maxstr_proc*nntyp,
384 & MPI_DOUBLE_PRECISION,Next,msg_out(4),
386 write (iout,*) "Send",msg_out(4)," complete (eneps)"
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)"
393 call MPI_Buffer_Detach(address,size,IERROR)
394 call MPI_Buffer_Attach(buffer(1),8*(2*maxstr_proc*maxnatlike
396 call MPI_BSend(nu(1,1,1,iprot),
397 & maxstr_proc*maxnatlike*maxdimnat,
398 & MPI_DOUBLE_PRECISION,Next,msg_out(5),
400 write (iout,*) "Send",msg_out(5)," complete (nu)"
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)"
408 call MPI_Buffer_Detach(address,size,IERROR)
409 write (iout,*) "Send and receive complete"
411 if (.not. mod_other_params) then
412 write (iout,*) "Processor",me1," calling dawrite_ene",
413 & " istart_conf",istart_conf," iend_conf",iend_conf
417 c write (iout,*) "assignment of enetb_orig"
418 do ii=1,iend_conf-istart_conf+1
420 enetb_orig(ii,j,iprot)=enetb(ii,j,iprot)
422 c write (iout,'(i5,20f8.2)')
423 c & ii,(enetb_orig(ii,j,iprot),j=1,n_ene)
426 if (.not. mod_other_params)
427 & call dawrite_ene(iprot,istart_conf,iend_conf,ientout)
435 if (.not.init_ene .and. mod_fourier(nloctyp).eq.0
436 & .and. .not. mod_elec .and. .not. mod_scp) then
440 c Change AL 12/30/2017
441 if (.not. mod_other_params) close (ientout)
446 c Lowest free energies of structural classes
449 if (.not.maxlik(iprot)) cycle
451 IF (NCHUNK_CONF(IPROT).EQ.1) THEN
454 do i=1,ntot_work(iprot)
458 do i=indstart(me1,iprot),indend(me1,iprot)
462 istart_conf=indstart(me1,iprot)
463 iend_conf=indend(me1,iprot)
465 do i=1,ntot_work(iprot)
469 iend_conf=ntot_work(iprot)
472 write (iout,*) "i2ii at make_list"
473 do i=1,ntot_work(iprot)
474 write (iout,*) "i",i," i2ii",i2ii(i,iprot)
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)
484 call emin_search(iprot)
488 if (.not. mod_other_params)
489 &open (ientin,file=benefiles(iprot),status="old",
490 & form="unformatted",access="direct",recl=lenrec_ene(iprot))
493 do istart_conf=indstart(me1,iprot),indend(me1,iprot),maxstr_proc
494 iend_conf=min0(istart_conf+maxstr_proc-1,indend(me1,iprot))
496 do istart_conf=1,ntot_work(iprot),maxstr_proc
497 iend_conf=min0(istart_conf+maxstr_proc-1,ntot_work(iprot))
500 c Read the chunk of energies and derivatives off a DA scratchfile.
502 ipass_conf=ipass_conf+1
503 do i=1,ntot_work(iprot)
507 do i=istart_conf,iend_conf
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)
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)
530 c Complete the calculation of the lowest energies over all classes and
531 c distribute the values to all procs
534 if (.not.maxlik(iprot)) cycle
535 do ibatch=1,natlike(iprot)+2
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)
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)
546 call MPI_Allreduce(elowest_aux(1,1),elowest_t(1,1),
547 & nbeta(ibatch,iprot),
548 & MPI_2DOUBLE_PRECISION, MPI_MINLOC, Comm1, IERROR)
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)
555 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 2"
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)
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)
572 c Allgather to provide all energies to all processors
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)
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,
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,
590 c Now determine which conformations will enter the database.
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)
603 c Make the list of conformations based on energy cut-off.
606 write (iout,*) "iprot",iprot," ibatch",ibatch," betmin",
607 & betmin(ibatch,iprot)
610 write (iout,*) "e_lowb",e_lowb(iprot)
611 write (iout,*) "t_lowb",t_lowb(iprot)
613 do ibatch=1,natlike(iprot)+2
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))
622 c write (iout,*) "i",i," ii",ii," kbatch",kbatch(i,iprot),
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
628 c write (iout,*) "Conformation",i," eini",eini(i,iprot),
629 c & " entfac",entfac(i,iprot)," e_lowb",
631 c & " t_lowb",t_lowb(iprot)
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)
640 write (iout,*) "beta",betaT(ib,ibatch,iprot),
643 & " elowest",elowest(ib,ibatch,iprot)," dene",dene,
644 & " enecut",enecut(iprot)
646 if (dene.lt.enecut(iprot)) then
648 list_conf(nn,iprot)=i
661 if (nn.gt.maxstr) then
662 write (iout,*) "Error - after applying cutoff the number",
663 & " of conformations for protein ",i," exceeds MAXSTR:",
665 write (iout,*) "The calculation is terminating."
668 call MPI_Finalize(ierror)
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
678 c All workers get the complete list of conformations.
680 call MPI_Allgather(ntot_work(iprot),1,MPI_INTEGER,
681 & scount(0,iprot),1,MPI_INTEGER,Comm1,IERROR)
684 idispl(i,iprot)=idispl(i-1,iprot)+scount(i-1,iprot)
687 write (iout,*) "Protein",iprot," Scount and Idispl"
689 write (iout,*) i,scount(i,iprot),idispl(i,iprot)
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)
696 write (iout,*) "Before REDUCE: ntot_work",ntot_work(iprot)
699 call MPI_Allreduce(ntot_work(iprot),nn,1,MPI_INTEGER,MPI_SUM,
703 write (iout,*) "After REDUCE: ntot_work",ntot_work(iprot)
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)
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))
724 c Construct the mapping of the new list to the original numbers of
730 do i=1,ntot_work(iprot)
731 tsil(list_conf(i,iprot),iprot)=i
734 write (iout,*) "Protein",i," List-to-conformation mapping"
736 write(iout,*) i,tsil(i,iprot)
741 c Divide the work again based on the current lists of conformations
743 call work_partition(.true.)
745 c If the conformations fit into memory, read them off a DA scratchfile.
749 if (.not.maxlik(iprot)) cycle
750 call restore_molinfo(iprot)
752 nchunk_conf(iprot)=iroof(scount(me1,iprot),maxstr_proc)
754 nchunk_conf(iprot)=iroof(ntot_work(iprot),maxstr_proc)
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.
762 open (icbase,file=bprotfiles(iprot),status="old",
763 & form="unformatted",access="direct",recl=lenrec(iprot))
765 call daread_ccoords(iprot,indstart(me1,iprot),
768 call daread_ccoords(iprot,1,ntot_work(iprot))
772 open (ientin,file=benefiles(iprot),status="old",
773 & form="unformatted",access="direct",recl=lenrec_ene(iprot))
775 call daread_ene(iprot,indstart(me1,iprot),
778 call daread_ene(iprot,1,ntot_work(iprot))
781 open (icbase,file=bprotfiles(iprot),status="old",
782 & form="unformatted",access="direct",recl=lenrec(iprot))
784 call daread_ccoords(iprot,indstart(me1,iprot),
787 call daread_ccoords(iprot,1,ntot_work(iprot))
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)
800 write (iout,*) "Protein",iprot,
801 & " off-memory storage of conformations; ",
802 & "energy will be evaluated in",nchunk_conf(iprot)," passes."
810 if (.not.maxlik(iprot)) cycle
812 write (iout,*) "E_TOTAL and ETOT_ORIG of protein",iprot
814 do i=1,ntot_work(iprot)
815 etot_orig(i,iprot)=e_total(list_conf(i,iprot),iprot)
817 write (iout,*) i,list_conf(i,iprot),
818 & e_total(list_conf(i,iprot),iprot),etot_orig(i,iprot)
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
831 if (me1 .eq. Master) call write_conf_count
833 call write_conf_count
836 write (iout,*) "ELOWEST at the end of MAKE_LIST"
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)
847 tcpu_fin = tcpu() - tcpu_ini
848 write (iout,*) "Time for creating list of conformations",tcpu_fin
850 t_func = t_func + tcpu_fin
853 c----------------------------------------------------------------------------
854 subroutine emin_search(iprot)
857 include "DIMENSIONS.ZSCOPT"
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))
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"
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)
891 do ibatch=1,natlike(iprot)+2
892 do ib=1,nbeta(ibatch,iprot)
893 elowest(ib,ibatch,iprot)=1.0d20
896 do ibatch=1,natlike(iprot)+2
902 do ib=1,nbeta(ibatch,iprot)
905 etoti=etoti+ww(kk)*enetb(jj,kk,iprot)
906 & *escal(kk,ib,ibatch,iprot)
908 if (ib.eq.1 .and. etoti.lt.elowest_ent(1,ibatch,iprot))
910 elowest_ent(1,ibatch,iprot)=etoti
911 elowest_ent(2,ibatch,iprot)=entfac(k,iprot)
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
920 c write (iout,*) ib,betaT(ib,ibatch,iprot),etoti,
923 write (iout,'(2i5,2e15.5,f8.3)') k,jj,
924 & etoti,elowest(ib,ibatch,iprot),betaT(ib,ibatch,iprot)
928 write (iout,'(2i5,20f8.2)') j,jj,(enetb(jj,kk,iprot),