1 subroutine averages(iprot)
4 include "DIMENSIONS.ZSCOPT"
11 include "COMMON.WEIGHTS"
12 include "COMMON.WEIGHTDER"
13 include "COMMON.ENERGIES"
14 include "COMMON.IOUNITS"
15 include "COMMON.VMCPAR"
16 include "COMMON.NAMES"
17 include "COMMON.INTERACT"
18 include "COMMON.TIME1"
19 include "COMMON.CHAIN"
20 include "COMMON.PROTFILES"
21 include "COMMON.COMPAR"
22 include "COMMON.CLASSES"
23 C Define local variables
24 integer i,ii,iii,inat,jj,j,k,kk,l,ik,jk,iprot,ib
25 integer ipass_conf,istart_conf,iend_conf
26 double precision energia(0:max_ene)
27 double precision etoti,sumpart,esquarei,emeani,elowesti,enepsjk
28 double precision aux,fac,ef1,ef2,em1,em2,var1,var2
29 double precision gnmr,tcpu_ini,tcpu
38 do ib=1,nbeta(1,iprot)
40 sumlikder(k,ib,iprot)=0.0d0
41 sumqder(k,ib,iprot)=0.0d0
44 sumlikeps(k,ib,iprot)=0.0d0
45 sumqeps(k,ib,iprot)=0.0d0
48 sumliktor(k,ib,iprot)=0.0d0
49 sumqtor(k,ib,iprot)=0.0d0
51 sumlik(ib,iprot)=0.0d0
52 efree(ib,1,iprot)=0.0d0
55 do ib=1,nbeta(2,iprot)
57 eave_pftot(k,ib,iprot)=0.0d0
58 eave_pfprimtot(k,ib,iprot)=0.0d0
59 eave_pfbistot(k,ib,iprot)=0.0d0
60 emix_pftot(k,ib,iprot)=0.0d0
61 emix_pfprimtot(k,ib,iprot)=0.0d0
62 emix_pfbistot(k,ib,iprot)=0.0d0
63 emixsq_pftot(k,ib,iprot)=0.0d0
66 enepsave_ftot(k,ib,iprot)=0.0d0
67 eneps_mix_ftot(k,ib,iprot)=0.0d0
68 eneps_mix_fbistot(k,ib,iprot)=0.0d0
69 eneps_mixsq_ftot(k,ib,iprot)=0.0d0
72 entorave_ftot(k,ib,iprot)=0.0d0
73 entorave_fprimtot(k,ib,iprot)=0.0d0
74 entorave_fbistot(k,ib,iprot)=0.0d0
75 entor_mix_ftot(k,ib,iprot)=0.0d0
76 entor_mix_fprimtot(k,ib,iprot)=0.0d0
77 entor_mix_fbistot(k,ib,iprot)=0.0d0
78 entor_mixsq_ftot(k,ib,iprot)=0.0d0
80 emean_ftot(ib,iprot)=0.0d0
81 ebis_ftot(ib,iprot)=0.0d0
82 esquare_ftot(ib,iprot)=0.0d0
84 c Conformation-dependent averages
85 do inat=1,natlike(iprot)
86 do ib=1,nbeta(inat+2,iprot)
87 do l=1,natdim(inat,iprot)
89 nu_pf(k,l,ib,inat,iprot)=0.0d0
92 nuepsave_f(k,l,ib,inat,iprot)=0.0d0
95 nutorave_f(k,l,ib,inat,iprot)=0.0d0
97 nuave(l,ib,inat,iprot)=0.0d0
102 c Calculate the contributions to averages from each processor or all
103 c contributions if calculations are run in uniprocessor mode.
104 c The derivatives of energy in epsilons are dumped to disk, if needed.
107 write (iout,*) "Protein",iprot," nchunk_conf",nchunk_conf(iprot)
109 IF (NCHUNK_CONF(IPROT).EQ.1) THEN
112 do i=1,ntot_work(iprot)
116 do i=indstart(me1,iprot),indend(me1,iprot)
121 do i=1,ntot_work(iprot)
126 do i=1,ntot_work(iprot)
127 write (iout,*) "i",i," i2ii",i2ii(i,iprot)
135 open (ientin,file=benefiles(iprot),status="old",
136 & form="unformatted",access="direct",recl=lenrec_ene(iprot))
139 do istart_conf=indstart(me1,iprot),indend(me1,iprot),maxstr_proc
140 iend_conf=min0(istart_conf+maxstr_proc-1,indend(me1,iprot))
142 do istart_conf=1,ntot_work(iprot),maxstr_proc
143 iend_conf=min0(istart_conf+maxstr_proc-1,ntot_work(iprot))
146 c Read the chunk of energies and derivatives off a DA scratchfile.
148 ipass_conf=ipass_conf+1
149 do i=1,ntot_work(iprot)
153 do i=istart_conf,iend_conf
158 write (iout,*) "ipass_conf",ipass_conf,
159 & " istart_conf",istart_conf," iend_conf",iend_conf
160 do i=1,ntot_work(iprot)
161 write (iout,*) "i",i," i2ii",i2ii(i,iprot)
165 call daread_ene(iprot,istart_conf,iend_conf)
172 c Put tohether all contributions.
177 c-------------------------------------------------------------------------------
178 subroutine ave_eval(iprot)
181 include "DIMENSIONS.ZSCOPT"
184 integer IERROR,ErrCode
188 include "COMMON.WEIGHTS"
189 include "COMMON.WEIGHTDER"
190 include "COMMON.ENERGIES"
191 include "COMMON.IOUNITS"
192 include "COMMON.VMCPAR"
193 include "COMMON.NAMES"
194 include "COMMON.INTERACT"
195 include "COMMON.TIME1"
196 include "COMMON.CHAIN"
197 include "COMMON.PROTFILES"
198 include "COMMON.THERMAL"
200 include "COMMON.CLASSES"
201 include "COMMON.COMPAR"
202 C Define local variables
203 integer i,ii,iii,jj,j,k,kk,l,m,ik,jk,iprot,ib,inat,
205 integer ipass_conf,istart_conf,iend_conf
206 double precision energia(0:max_ene)
207 double precision etoti,sumpart,esquarei,emeani,
208 & elowesti,enepsjk,eprim,ebis,eprimi,ebisi,etoti_orig,
209 & entorjk,eave_pft(max_ene),emix_pft(max_ene),
210 & esquare_ft,efree_t,emixsq_pft(max_ene),
211 & eneps_mixt(nntyp),eneps_meant(nntyp),
212 & enepsave_ft(nntyp),eneps_mix_ft(nntyp),
213 & eneps_mixsq_ft(nntyp),emean_ft
214 double precision aux,auxf,fac,facf,ef1,ef2,em1,em2,var1,var2,
215 & deltei,deltei_orig,temper,elowest_all
216 double precision gnmr,tcpu_ini,tcpu
217 double precision ftune_epsprim
218 external ftune_epsprim
224 C Compute the likelihood sum
225 DO IB=1,NBETA(1,IPROT)
226 elowest_all=elowest(ib,1,iprot)
228 write(iout,*) "iprot",iprot," ib",ib,
229 & " elowest",elowest_l(ib,iprot)
231 fac=betaT(ib,1,iprot)
232 temper=1.0d0/(fac*Rgas)
234 sumlik(ib,iprot)=0.0d0
236 sumlikder(k,ib,iprot)=0.0d0
237 sumqder(k,ib,iprot)=0.0d0
239 do j=1,ntot_work(iprot)
242 if (i.gt.0) write (iout,*) "i",i," iprot",iprot,
243 & " indstart",indstart(me1,iprot),
244 & " indend",indend(me1,iprot)
249 c Temperature-dependent energy
252 etoti=etoti+ww(k)*escal(k,ib,1,iprot)
255 deltei=etoti-elowest(ib,1,iprot)
257 write (iout,*) "etoti",etoti," deltei",deltei
258 write (iout,'(20f8.3)') (ww(k),k=1,n_ene)
259 write (iout,'(20f8.3)') (enetb(jj,k,iprot),
262 aux=entfac(i,iprot)+fac*deltei
264 write (iout,'(2i5,f5.2,7(a,e15.5))')
265 & i,ib,fac," e_total",etoti,
266 & " eini",eini(i,iprot)," entfac",entfac(i,iprot),
267 & " e_lowest",elowest(ii,ib,iprot)," aux",aux
269 sumlik(ib,iprot)=sumlik(ib,iprot)+aux*Ptab(jj,ib,iprot)
271 sumlikder(k,ib,iprot)=sumlikder(k,ib,iprot)+
272 & +enetb(jj,k,iprot)*escal(k,ib,1,iprot)*Ptab(jj,ib,iprot)
278 sumlikeps(k,ib,iprot)=sumlikeps(k,ib,iprot)+
279 & (ftune_epsprim(eps(ik,jk))*
280 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot))
287 if (mask_tor(jk,ik).gt.0) then
289 entorjk=entor(k,jj,iprot)
290 sumliktor(k,ib,iprot)=sumliktor(k,ib,iprot)
291 & +Ptab(jj,ib,iprot)*entorjk*escal(13,ib,1,iprot)
295 if (aux.le.150.0) then
299 sumqder(k,ib,iprot)=sumqder(k,ib,iprot)
300 & +aux*enetb(jj,k,iprot)*escal(k,ib,1,iprot)
306 sumqeps(k,ib,iprot)=sumqeps(k,ib,iprot)+
307 & (ftune_epsprim(eps(ik,jk))*
308 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot))*aux
314 if (mask_tor(jk,ik).gt.0) then
316 entorjk=entor(k,jj,iprot)
318 & sumqtor(k,ib,iprot)+aux*entorjk*escal(13,ib,1,iprot)
326 efree(ib,1,iprot)=sumpart
328 write (iout,*) " ib",ib," iprot",iprot,
329 & " sumlik",sumlik(ib,iprot),
330 & " sumq",efree(ib,1,iprot)
333 C Calculation of heat capacity
334 DO IB=1,NBETA(2,IPROT)
335 elowest_all=elowest(ib,2,iprot)
337 write(iout,*) "iprot",iprot," ib",ib,
338 & " elowest",elowest(ib,2,iprot)
339 write(iout,*) "escalbis",(escalbis(k,ib,2,iprot),k=1,n_ene)
341 fac=betaT(ib,2,iprot)
342 temper=1.0d0/(fac*Rgas)
348 write (iout,*) "Before sum, ib=",ib
349 write (iout,*) "efree",efree(ib,2,iprot),sumpart,
350 & " emean",emean_ftot(ib,iprot),
351 & " esquare",esquare_ftot(ib,iprot),
352 & " ebis",ebis_ftot(ib,iprot),
353 & " emix_pfprim",(emix_pfprimtot(k,ib,iprot),k=1,n_ene)
355 do j=1,ntot_work(iprot)
358 if (i.gt.0) write (iout,*) "i",i," iprot",iprot,
359 & " indstart",indstart(me1,iprot),
360 & " indend",indend(me1,iprot)
366 write (iout,*) "ib",ib," j",j,
367 write (iout,*) "nu",(nu(k,jj,iprot),k=1,
372 c Temperature-dependent energy
378 etoti=etoti+ww(k)*escal(k,ib,2,iprot)
380 eprim=eprim+ww(k)*escalprim(k,ib,2,iprot)
382 ebis=ebis+ww(k)*escalbis(k,ib,2,iprot)
385 deltei=etoti-elowest(ib,2,iprot)
387 write (iout,*) "etoti",etoti," deltei",deltei
388 write (iout,'(20f8.3)') (ww(k),k=1,n_ene)
389 write (iout,'(20f8.3)') (enetb(jj,k,iprot),
392 aux=entfac(i,iprot)+fac*deltei
394 write (iout,'(f5.2,7(a,e15.5))')
395 & fac," e_total",etoti,
396 & " eini",eini(i,iprot)," entfac",entfac(i,iprot),
397 & " eprim",eprim," ebis",ebis,
398 & " e_lowest",elowest(ib,2,iprot)," aux",aux
400 if (aux.le.150.0) then
403 etoti=etoti-temper*eprim
404 emeani=emeani+etoti*aux
405 esquarei=esquarei+aux*etoti**2
408 eave_pftot(k,ib,iprot)=eave_pftot(k,ib,iprot)
409 & +aux*enetb(jj,k,iprot)*escal(k,ib,2,iprot)
410 c write (iout,*) "eave_pf",eave_pf(k,ii,ib,iprot)
411 eave_pfprimtot(k,ib,iprot)=eave_pfprimtot(k,ib,iprot)
412 & +aux*enetb(jj,k,iprot)*(escal(k,ib,2,iprot)-
413 & temper*escalprim(k,ib,2,iprot))
414 eave_pfbistot(k,ib,iprot)=eave_pfbistot(k,ib,iprot)
415 & +aux*enetb(jj,k,iprot)*escalbis(k,ib,2,iprot)
416 emix_pftot(k,ib,iprot)=emix_pftot(k,ib,iprot)
417 & +aux*enetb(jj,k,iprot)*etoti*escal(k,ib,2,iprot)
418 emix_pfprimtot(k,ib,iprot)=emix_pfprimtot(k,ib,iprot)
419 & +aux*enetb(jj,k,iprot)*etoti*(escal(k,ib,2,iprot)
420 & -temper*escalprim(k,ib,2,iprot))
421 emix_pfbistot(k,ib,iprot)=emix_pfbistot(k,ib,iprot)
422 & +aux*enetb(jj,k,iprot)*ebis*escal(k,ib,2,iprot)
423 emixsq_pftot(k,ib,iprot)=emixsq_pftot(k,ib,iprot)
424 & +aux*enetb(jj,k,iprot)*etoti**2*escal(k,ib,2,iprot)
430 enepsjk=ftune_epsprim(eps(ik,jk))*
431 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot)
432 enepsave_ftot(k,ib,iprot)=enepsave_ftot(k,ib,iprot)
434 eneps_mix_ftot(k,ib,iprot)=
435 & eneps_mix_ftot(k,ib,iprot)+aux*enepsjk*etoti
436 eneps_mix_fbistot(k,ib,iprot)=
437 & eneps_mix_fbistot(k,ib,iprot)+aux*enepsjk*ebis
438 eneps_mixsq_ftot(k,ib,iprot)=
439 & eneps_mixsq_ftot(k,ib,iprot)+aux*enepsjk*etoti**2
445 if (mask_tor(jk,ik).gt.0) then
447 entorjk=entor(k,jj,iprot)
448 c write (iout,*) " k"," ik",ik," jk",jk,
449 c & " entor",entorjk," contirb",
450 c & aux*entorjk*escal(13,ib,2,iprot)
451 entorave_ftot(k,ib,iprot)=
452 & entorave_ftot(k,ib,iprot)
453 & +aux*entorjk*escal(13,ib,2,iprot)
454 c write (iout,*) "entorave_f",
455 c & entorave_ftot(k,ib,iprot)
456 entorave_fprimtot(k,ib,iprot)=
457 & entorave_fprimtot(k,ib,iprot)
458 & +aux*entorjk*(escal(13,ib,2,iprot)-
459 & temper*escalprim(13,ib,2,iprot))
460 entorave_fbistot(k,ib,iprot)=
461 & entorave_fbistot(k,ib,iprot)
462 & +aux*entorjk*escalbis(13,ib,2,iprot)
463 entor_mix_ftot(k,ib,iprot)=
464 & entor_mix_ftot(k,ib,iprot)
465 & +aux*entorjk*etoti*escal(13,ib,2,iprot)
466 entor_mix_fprimtot(k,ib,iprot)=
467 & entor_mix_fprimtot(k,ib,iprot)
468 & +aux*entorjk*etoti*(escal(13,ib,2,iprot)-
469 & temper*escalprim(13,ib,2,iprot))
470 entor_mix_fbistot(k,ib,iprot)=
471 & entor_mix_fbistot(k,ib,iprot)
472 & +aux*entorjk*ebis*escal(13,ib,2,iprot)
473 entor_mixsq_ftot(k,ib,iprot)=
474 & entor_mixsq_ftot(k,ib,iprot)
475 & +aux*entorjk*etoti**2*escal(13,ib,2,iprot)
482 efree(ib,2,iprot)=sumpart
483 emean_ftot(ib,iprot)=emeani
484 ebis_ftot(ib,iprot)=ebisi
485 esquare_ftot(ib,iprot)=esquarei
487 write (iout,*) "After sum, ib=",ib
488 write (iout,*) "efree",efree(ib,2,iprot),sumpart,
489 & " emean",emean_ftot(ib,iprot),
490 & " esquare",esquare_ftot(ib,iprot),
491 & " ebis",ebis_ftot(ib,iprot),
492 & " emix_pfprim",(emix_pfprimtot(k,ib,iprot),k=1,n_ene)
494 ebis_ftot(ib,iprot)=ebis_ftot(ib,iprot)*temper
496 eave_pfbistot(k,ib,iprot)=
497 & eave_pfbistot(k,ib,iprot)*temper
498 emix_pfbistot(k,ib,iprot)=
499 & emix_pfbistot(k,ib,iprot)*temper
502 eneps_mix_fbistot(k,ib,iprot)=
503 & eneps_mix_fbistot(k,ib,iprot)*temper
506 entorave_fbistot(k,ib,iprot)=
507 & entorave_fbistot(k,ib,iprot)*temper
508 entor_mix_fbistot(k,ib,iprot)=
509 & entor_mix_fbistot(k,ib,iprot)*temper
512 write (iout,*) "eave_pf",(eave_pftot(k,ib,iprot),
514 write (iout,*) "entorave_f",(entorave_ftot(k,ib,iprot),
518 write (iout,*) "ib",ib," temper",temper,
519 & " ebis",ebis_ftot(ib,iprot)
522 C Calculation of conformation-dependent averages
523 DO INAT=1,NATLIKE(IPROT)
524 DO IB=1,NBETA(I+2,IPROT)
525 elowest_all=elowest(ib,inat+2,iprot)
527 write(iout,*) "iprot",iprot," ib",ib,
528 & " elowest",elowest(ib,iprot)
530 fac=betaT(ib,2,iprot)
531 temper=1.0d0/(fac*Rgas)
533 do j=1,ntot_work(iprot)
536 if (i.gt.0) write (iout,*) "i",i," iprot",iprot,
537 & " indstart",indstart(me1,iprot),
538 & " indend",indend(me1,iprot)
544 write (iout,*) "ib",ib," j",j,
545 write (iout,*) "nu",(nu(k,jj,iprot),k=1,
550 c Temperature-dependent energy
553 etoti=etoti+ww(k)*escal(k,ib,inat+2,iprot)
556 deltei=etoti-elowest(ib,inat+2,iprot)
558 write (iout,*) "etoti",etoti," deltei",deltei
559 write (iout,'(20f8.3)') (ww(k),k=1,n_ene)
560 write (iout,'(20f8.3)') (enetb(jj,k,iprot),
563 aux=entfac(i,iprot)+fac*deltei
565 write (iout,'(f5.2,7(a,e15.5))')
566 & fac," e_total",etoti,
567 & " eini",eini(i,iprot)," entfac",entfac(i,iprot),
568 & " eprim",eprim," ebis",ebis,
569 & " e_lowest",elowest(ib,inat+2,iprot)," aux",aux
571 if (aux.le.150.0) then
574 c 4/13/04 AL Components of the conformation-dependent averages
576 eave_nat_pftot(k,ib,inat,iprot)=
577 & eave_nat_pftot(k,ib,inat,iprot)
578 & +aux*enetb(jj,k,iprot)*escal(k,ib,inat+2,iprot)
584 enepsjk=ftune_epsprim(eps(ik,jk))*
585 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot)
586 enepsave_nat_ftot(k,ib,inat,iprot)=
587 & enepsave_nat_ftot(k,ib,inat,iprot)
594 if (mask_tor(jk,ik).gt.0) then
596 entorjk=entor(k,jj,iprot)
597 c write (iout,*) " k"," ik",ik," jk",jk,
598 c & " entor",entorjk," contirb",
599 c & aux*entorjk*escal(13,ib,inat+2,iprot)
600 entorave_nat_ftot(k,ib,inat,iprot)=
601 & entorave_nat_ftot(k,ib,inat,iprot)
602 & +aux*entorjk*escal(13,ib,inat+2,iprot)
606 do l=1,natdim(inat,iprot)
607 nuave(l,ib,inat,iprot)=nuave(l,ib,inat,iprot)
608 & +aux*nu(l,inat,jj,iprot)
610 nu_pf(k,l,ib,inat,iprot)=nu_pf(k,l,ib,inat,iprot)
611 & +aux*enetb(jj,k,iprot)*nu(k,inat,jj,iprot)*
612 & escal(k,ib,inat+2,iprot)
618 nuepsave_f(k,l,ib,inat,iprot)=
619 & nuepsave_f(k,l,ib,inat,iprot)+aux*enepsjk*
620 & nu(l,inat,jj,iprot)
626 if (mask_tor(jk,ik).gt.0) then
628 nutorave_f(k,l,ib,inat,iprot)=
629 & nutorave_f(k,l,ib,inat,iprot)
630 & +aux*entorjk*escal(13,ib,inat+2,iprot)*
631 & nu(l,inat,jj,iprot)
639 write (iout,*) "iprot",iprot," ib",ib,
640 write (iout,*) "nuave"
641 write (iout,'(20f10.5)') (nuave(k,ib,iprot),
642 & k=1,natconstr(iprot))
645 write (iout,*) "inat",inat,
646 & " efree_nat",efree_nat(ib,inat,iprot)
650 write (iout,*) "iprot",iprot," ib",ib
651 write (iout,*) "nuave0"
652 write (iout,'(20f10.5)') (nuave(k,ib,inat,iprot),
653 & k=1,natdim(inat,iprot))
659 c-------------------------------------------------------------------------------
660 subroutine ave_sum(iprot)
663 include "DIMENSIONS.ZSCOPT"
666 integer IERROR,ErrCode
670 include "COMMON.WEIGHTS"
671 include "COMMON.WEIGHTDER"
672 include "COMMON.ENERGIES"
673 include "COMMON.IOUNITS"
674 include "COMMON.VMCPAR"
675 include "COMMON.NAMES"
676 include "COMMON.INTERACT"
677 include "COMMON.TIME1"
678 include "COMMON.CHAIN"
679 include "COMMON.PROTFILES"
681 include "COMMON.COMPAR"
682 C Define local variables
683 integer i,ii,iii,jj,j,k,l,ik,jk,iprot,ib,inat
684 integer ipass_conf,istart_conf,iend_conf
685 double precision energia(0:max_ene)
686 double precision etoti,sumpart,esquarei,emeani,elowesti,enepsjk,
687 & eave_pft(max_ene),emix_pft(max_ene),eave_pfprimt(max_ene),
688 & eave_pfbist(max_ene),emix_pfprimt(max_ene),emix_pfbist(max_ene),
689 & esquare_ft,efree_t,
690 & emixsq_pft(max_ene),eneps_mixt(nntyp),eneps_meant(nntyp),
691 & enepsave_ft(nntyp),eneps_mix_ft(nntyp),entorave_ft(maxtor_var),
692 & entor_mix_ft(maxtor_var),
693 & eneps_mix_fbist(nntyp),entorave_fbist(maxtor_var),
694 & entorave_fprimt(maxtor_var),entor_mix_fprimt(maxtor_var),
695 & entor_mix_fbist(maxtor_var),eneps_mixsq_ft(nntyp),
696 & entor_mixsq_ft(maxtor_var),emean_ft,ebis_ft,nuave_t(maxdimnat),
697 & nu_pft(max_ene,maxdimnat),
698 & nuepsave_ft(nntyp,maxdimnat),
699 & nutorave_ft(maxtor_var,maxdimnat),
700 & sumlik_t,sumlikder_t(max_ene),sumlikeps_t(nntyp),
701 & sumliktor_t(maxtor_var),
702 & sumq_t,sumqder_t(max_ene),sumqeps_t(nntyp),sumqtor_t(maxtor_var)
704 double precision aux,fac,ef1,ef2,em1,em2,var1,var2,efree_tot,facF,
706 double precision gnmr,tcpu_ini,tcpu
712 c Maximum likelihood contribution
713 DO IB=1,NBETA(1,IPROT)
714 fac=betaT(ib,1,iprot)
717 write (iout,*) "Processor",me,me1," calling MPI_Reduce: 3"
718 write (iout,*) "iprot",iprot," ib",ib
719 write (iout,*) "sumlik",sumlik(ib,iprot),
720 & " sumq",efree(ib,1,iprot)
723 call MPI_Reduce( sumlik(ib,iprot), sumlik_t,1,
724 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
725 call MPI_Reduce( efree(ib,1,iprot), sumq_t,1,
726 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
728 write (iout,*) "sumlik",sumlik(ib,iprot)," sumlik_t",sumlik_t
729 write (iout,*) "sumq",efree(ib,1,iprot)," sumq_t",sumq_t
732 call MPI_Reduce(sumlikder(1,ib,iprot),sumlikder_t(1),
734 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
735 call MPI_Reduce(sumlikeps(1,ib,iprot),
736 & sumlikeps_t(1), nntyp,
737 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
738 call MPI_Reduce(sumliktor(1,ib,iprot),
739 & sumliktor_t(1), ntor_var,
740 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
741 call MPI_Reduce(sumqder(1,ib,iprot),sumqder_t(1),n_ene,
742 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
743 call MPI_Reduce(sumqeps(1,ib,iprot),sumqeps_t(1), nntyp,
744 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
745 call MPI_Reduce(sumqtor(1,ib,iprot),sumqtor_t(1), ntor_var,
746 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
748 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 3"
751 if (me1.eq.master) then
753 write (iout,*) "ib",ib,
754 & " elowest",elowest(ib,1,iprot),
755 & " sumlik",sumlik_t," qsum",sumq_t," fac",fac
758 sumlikder(k,ib,iprot)=fac*(
760 & -sumqder_t(k)/sumq_t)
763 sumlikeps(k,ib,iprot)=fac*(
764 & sumlikeps_t(k)-sumqeps_t(k)/sumq_t)
766 c write (iout,*) "eavetor",eave_pftot(13,ib,iprot),
767 c & eave_pftot(19,ib,iprot)
769 sumliktor(k,ib,iprot)=fac*(
770 & sumliktor_t(k)-sumqtor_t(k)/sumq_t)
772 sumlik(ib,iprot)=sumlik_t+dlog(sumq_t)
773 efree(ib,1,iprot)=sumq_t
775 write (iout,*) "ib",ib," iprot",iprot," final sumlik",
776 & sumlik(ib,iprot)," sumq",efree(ib,1,iprot)
781 sumlikder(k,ib,iprot)=fac*(
782 & sumlikder(k,ib,iprot)
783 & -sumqder(k,ib,iprot)/efree(ib,1,iprot))
786 sumlikeps(k,ib,iprot)=fac*(
787 & sumlikeps(k,ib,iprot)
788 & -sumqeps(k,ib,iprot)/efree(ib,1,iprot))
791 sumliktor(k,ib,iprot)=fac*(
792 & sumliktor(k,ib,iprot)
793 & -sumqtor(k,ib,iprot)/efree(ib,1,iprot))
795 sumlik(ib,iprot)=sumlik(ib,iprot)+dlog(efree(ib,1,iprot)
796 c & -elowest(nbeta(iprot)+ib,iprot)*fac
800 if (imask(k).gt.0) then
802 sumlikder(ii,ib,iprot)=sumlikder(k,ib,iprot)
806 c Heat capacity and averages
807 DO IB=1,NBETA(2,IPROT)
808 fac=betaT(ib,2,iprot)
811 write (iout,*) "Processor",me,me1," calling MPI_Reduce: 3"
812 write (iout,*) "iprot",iprot," ib",ib
815 call MPI_Reduce( efree(ib,2,iprot), efree_t,1,
816 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
818 write (iout,*) "efree",efree(iprot
819 write (iout,*) "efree_t",efree_t
822 call MPI_Reduce(emean_ftot(ib,iprot),emean_ft,1,
823 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
824 call MPI_Reduce(ebis_ftot(ib,iprot),ebis_ft,1,
825 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
826 call MPI_Reduce(esquare_ftot(ib,iprot),esquare_ft,1,
827 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
828 call MPI_Reduce(eave_pftot(1,ib,iprot),eave_pft,
830 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
831 call MPI_Reduce(eave_pfprimtot(1,ib,iprot),
832 & eave_pfprimt,n_ene,
833 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
834 call MPI_Reduce(eave_pfbistot(1,ib,iprot),
836 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
837 c write (iout,*) "eave_pf",(eave_pf(k,iprot),
839 c write (iout,*) "eave_pft",(eave_pft(k),k=1,n_ene)
840 call MPI_Reduce(emix_pftot(1,ib,iprot),emix_pft,
842 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
843 call MPI_Reduce(emix_pfprimtot(1,ib,iprot),
844 & emix_pfprimt,n_ene,
845 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
846 call MPI_Reduce(emix_pfbistot(1,ib,iprot),
848 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
849 call MPI_Reduce(emixsq_pftot(1,ib,iprot),
851 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
852 call MPI_Reduce(enepsave_ftot(1,ib,iprot),
853 & enepsave_ft, nntyp,
854 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
855 call MPI_Reduce(eneps_mix_ftot(1,ib,iprot),
856 & eneps_mix_ft,nntyp,
857 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
858 call MPI_Reduce(eneps_mix_fbistot(1,ib,iprot),
859 & eneps_mix_fbist,nntyp,
860 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
861 call MPI_Reduce(eneps_mixsq_ftot(1,ib,iprot),
862 & eneps_mixsq_ft,nntyp,
863 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
864 c write (iout,*) "enepsave_f",(enepsave_f(k,iprot),
866 c write (iout,*) "enepsave_ft",(enepsave_ft(k),
868 call MPI_Reduce(entorave_ftot(1,ib,iprot),
869 & entorave_ft, ntor_var,
870 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
871 call MPI_Reduce(entorave_fprimtot(1,ib,iprot),
872 & entorave_fprimt, ntor_var,
873 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
874 call MPI_Reduce(entorave_fbistot(1,ib,iprot),
875 & entorave_fbist, ntor_var,
876 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
877 call MPI_Reduce(entor_mix_ftot(1,ib,iprot),
878 & entor_mix_ft,ntor_var,
879 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
880 call MPI_Reduce(entor_mix_fprimtot(1,ib,iprot),
881 & entor_mix_fprimt,ntor_var,
882 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
883 call MPI_Reduce(entor_mix_fbistot(1,ib,iprot),
884 & entor_mix_fbist,ntor_var,
885 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
886 call MPI_Reduce(entor_mixsq_ftot(1,ib,iprot),
887 & entor_mixsq_ft,ntor_var,
888 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
889 c write (iout,*) "entorave_f",(entorave_f(k,iprot),
891 c write (iout,*) "entorave_ft",(entorave_ft(k),
894 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 3"
897 if (me1.eq.master) then
898 elowest_all=elowest(ib,2,iprot)
900 write (iout,*) "ib",ib,
901 & " elowest",elowest(ib,iprot),
902 & "efree",efree_t," fac",fac," facF",facF,
903 & " efree_tot",efree_tot
906 eave_pftot(k,ib,iprot)=eave_pft(k)/efree_t
907 eave_pfprimtot(k,ib,iprot)=eave_pfprimt(k)/efree_t
908 eave_pfbistot(k,ib,iprot)=eave_pfbist(k)/efree_t
909 emix_pftot(k,ib,iprot)=emix_pft(k)/efree_t
910 emix_pfprimtot(k,ib,iprot)=emix_pfprimt(k)/efree_t
911 emix_pfbistot(k,ib,iprot)=emix_pfbist(k)/efree_t
912 emixsq_pftot(k,ib,iprot)=emixsq_pft(k)/efree_t
915 enepsave_ftot(k,ib,iprot)=enepsave_ft(k)/efree_t
916 eneps_mix_ftot(k,ib,iprot)=eneps_mix_ft(k)/efree_t
917 eneps_mix_fbistot(k,ib,iprot)=eneps_mix_fbist(k)/efree_t
918 eneps_mixsq_ftot(k,ib,iprot)=eneps_mixsq_ft(k)/efree_t
920 c write (iout,*) "eavetor",eave_pftot(13,ib,iprot),
921 c & eave_pftot(19,ib,iprot)
923 entorave_ftot(k,ib,iprot)=entorave_ft(k)/
925 c write (iout,*) "iprot",iprot," ib",ib," k",k,
926 c & " entorave_ftot", entorave_ftot(k,ib,iprot)
927 entorave_fprimtot(k,ib,iprot)=entorave_fprimt(k)/efree_t
928 entorave_fbistot(k,ib,iprot)=entorave_fbist(k)/efree_t
929 entor_mix_ftot(k,ib,iprot)=entor_mix_ft(k)/efree_t
930 entor_mix_fprimtot(k,ib,iprot)=entor_mix_fprimt(k)/efree_t
931 entor_mix_fbistot(k,ib,iprot)=entor_mix_fbist(k)/efree_t
932 entor_mixsq_ftot(k,ib,iprot)=entor_mixsq_ft(k)/efree_t
934 emean_ftot(ib,iprot)=emean_ft/efree_t
935 ebis_ftot(ib,iprot)=ebis_ft/efree_t
936 esquare_ftot(ib,iprot)=esquare_ft/efree_t
937 efree(ib,2,iprot)=-dlog(efree_t)/fac+elowest(ib,2,iprot)
941 eave_pftot(k,ib,iprot)=eave_pftot(k,ib,iprot)
943 eave_pfprimtot(k,ib,iprot)=eave_pfprimtot(k,ib,iprot)
945 eave_pfbistot(k,ib,iprot)=eave_pfbistot(k,ib,iprot)
947 emix_pftot(k,ib,iprot)=emix_pftot(k,ib,iprot)/efree(ib,iprot)
948 emix_pfprimtot(k,ib,iprot)=emix_pfprimtot(k,ib,iprot)
950 emix_pfbistot(k,ib,iprot)=emix_pfbistot(k,ib,iprot)
952 emixsq_pftot(k,ib,iprot)=emixsq_pftot(k,ib,iprot)
956 enepsave_ftot(k,ib,iprot)=enepsave_ftot(k,ib,iprot)
958 eneps_mix_ftot(k,ib,iprot)=eneps_mix_ftot(k,ib,iprot)
960 eneps_mixsq_ftot(k,ib,iprot)=eneps_mixsq_ftot(k,ib,iprot)
964 entorave_ftot(k,ib,iprot)=entorave_f(k,ib,iprot)
966 entor_mix_ftot(k,ib,iprot)=entor_mix_ftot(k,ib,iprot)
968 entor_mixsq_ftot(k,ib,iprot)=entor_mixsq_ftot(k,ib,iprot)
971 emean_ftot(ib,iprot)=emean_ftot(ib,iprot)/efree(ib,2,iprot)
972 ebis_ftot(ib,iprot)=ebis_ftot(ib,iprot)/efree(ib,2,iprot)
973 esquare_ftot(ib,iprot)=esquare_ftot(ib,iprot)/efree(ib,2,iprot)
976 c 4/13/04 AL Components of the correlation coefficients and their derivatives
977 DO INAT=1,NATLIKE(IPROT)
978 DO IB=1,NBETA(INAT+2,IPROT)
980 call MPI_Reduce( efree(ib,inat+2,iprot), efree_t,1,
981 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
982 call MPI_Reduce( eave_nat_pftot(1, ib,inat,iprot), eave_pft,
984 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
985 call MPI_Reduce( enepsave_nat_ftot(1, ib,inat,iprot),
986 & enepsave_ft, nntyp,
987 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
988 call MPI_Reduce(entorave_nat_ftot(1,ib,inat,iprot),
989 & entorave_ft, ntor_var,
990 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
991 call MPI_Reduce(nuave(1,ib,inat,iprot),nuave_t(1),
992 & natdim(inat,iprot), MPI_DOUBLE_PRECISION, MPI_SUM,
993 & Master, Comm1, IERROR)
995 write (iout,*) "After REDUCE nuave",iprot,ib
996 write (iout,'(20f10.5)')
997 & (nuave(l,ib,iprot),l=1,natconstr(iprot))
999 call MPI_Reduce(nu_pf(1,1,ib,inat,iprot),nu_pft(1,1),
1000 & max_ene*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1001 & MPI_SUM, Master, Comm1, IERROR)
1002 call MPI_Reduce(nuepsave_f(1,1,ib,inat,iprot),
1004 & nntyp*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1005 & MPI_SUM, Master, Comm1, IERROR)
1006 call MPI_Reduce(nutorave_f(1,1,ib,inat,iprot),
1008 & maxtor_var*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1009 & MPI_SUM, Master, Comm1, IERROR)
1011 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 3"
1014 if (me1.eq.master) then
1016 write (iout,*) "ib",ib,
1017 & " elowest",elowest(ib,iprot),
1018 & "efree",efree_t," fac",fac,
1019 & " efree_tot",efree_tot
1021 do l=1,natdim(inat,iprot)
1023 nu_pf(k,l,ib,inat,iprot)=nu_pft(k,l)/efree_t
1026 nuepsave_f(k,l,ib,inat,iprot)=nuepsave_ft(k,l)/efree_t
1029 nutorave_f(k,l,ib,inat,iprot)=nutorave_ft(k,l)/efree_t
1031 nuave(l,ib,inat,iprot)=nuave_t(l)/efree_t
1034 eave_nat_pftot(k,ib,inat,iprot)=eave_pft(k)/efree_t
1037 enepsave_nat_ftot(k,ib,inat,iprot)=enepsave_ft(k)/efree_t
1040 entorave_nat_ftot(k,ib,inat,iprot)=entorave_ft(k)/efree_t
1044 do l=1,natdim(inat,iprot)
1046 nu_pf(k,l,ib,inat,iprot)=nu_pf(k,l,ib,inat,iprot)
1047 & /efree(ib,inat+2,iprot)
1050 nuepsave_f(k,l,ib,inat,iprot)=nuepsave_f(k,l,ib,inat,iprot)
1051 & /efree(ib,inat+2,iprot)
1054 nutorave_ftot(k,l,ib,inat,iprot)=
1055 & nutorave_ftot(k,l,ib,inat,iprot)
1056 & /efree(ib,inat+2,iprot)
1058 nuave(l,ib,inat,iprot)=nuave(l,ib,inat,iprot)
1059 & /efree(ib,inat+2,iprot)
1062 eave_nat_pftot(k,ib,inat,iprot)=
1063 & eave_nat_pftot(k,ib,inat,iprot)
1064 & /efree(ib,inat+2,iprot)
1067 enepsave_nat_ftot(k,ib,inat,iprot)=
1068 & enepsave_nat_ftot(k,ib,inat,iprot)/efree(ib,inat+2,iprot)
1071 enetorave_nat_ftot(k,ib,inat,iprot)=
1072 & enetorave_nat_ftot(k,ib,inat,iprot)/efree(ib,inat+2,iprot)
1077 write (iout,*) "ib",ib," efree_tot",efree_tot