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
52 sumlikang(k,ib,iprot)=0.0d0
53 sumqang(k,ib,iprot)=0.0d0
55 sumlik(ib,iprot)=0.0d0
56 efree(ib,1,iprot)=0.0d0
59 do ib=1,nbeta(2,iprot)
61 eave_pftot(k,ib,iprot)=0.0d0
62 eave_pfprimtot(k,ib,iprot)=0.0d0
63 eave_pfbistot(k,ib,iprot)=0.0d0
64 emix_pftot(k,ib,iprot)=0.0d0
65 emix_pfprimtot(k,ib,iprot)=0.0d0
66 emix_pfbistot(k,ib,iprot)=0.0d0
67 emixsq_pftot(k,ib,iprot)=0.0d0
70 enepsave_ftot(k,ib,iprot)=0.0d0
71 eneps_mix_ftot(k,ib,iprot)=0.0d0
72 eneps_mix_fbistot(k,ib,iprot)=0.0d0
73 eneps_mixsq_ftot(k,ib,iprot)=0.0d0
76 entorave_ftot(k,ib,iprot)=0.0d0
77 entorave_fprimtot(k,ib,iprot)=0.0d0
78 entorave_fbistot(k,ib,iprot)=0.0d0
79 entor_mix_ftot(k,ib,iprot)=0.0d0
80 entor_mix_fprimtot(k,ib,iprot)=0.0d0
81 entor_mix_fbistot(k,ib,iprot)=0.0d0
82 entor_mixsq_ftot(k,ib,iprot)=0.0d0
85 enangave_ftot(k,ib,iprot)=0.0d0
86 enang_mix_ftot(k,ib,iprot)=0.0d0
87 enang_mixsq_ftot(k,ib,iprot)=0.0d0
89 emean_ftot(ib,iprot)=0.0d0
90 ebis_ftot(ib,iprot)=0.0d0
91 esquare_ftot(ib,iprot)=0.0d0
93 c Conformation-dependent averages
94 do inat=1,natlike(iprot)
95 do ib=1,nbeta(inat+2,iprot)
96 do l=1,natdim(inat,iprot)
98 nu_pf(k,l,ib,inat,iprot)=0.0d0
101 nuepsave_f(k,l,ib,inat,iprot)=0.0d0
104 nutorave_f(k,l,ib,inat,iprot)=0.0d0
107 nuangave_f(k,l,ib,inat,iprot)=0.0d0
109 nuave(l,ib,inat,iprot)=0.0d0
114 c Calculate the contributions to averages from each processor or all
115 c contributions if calculations are run in uniprocessor mode.
116 c The derivatives of energy in epsilons are dumped to disk, if needed.
119 write (iout,*) "Protein",iprot," nchunk_conf",nchunk_conf(iprot)
121 IF (NCHUNK_CONF(IPROT).EQ.1) THEN
124 do i=1,ntot_work(iprot)
128 do i=indstart(me1,iprot),indend(me1,iprot)
133 do i=1,ntot_work(iprot)
138 do i=1,ntot_work(iprot)
139 write (iout,*) "i",i," i2ii",i2ii(i,iprot)
147 open (ientin,file=benefiles(iprot),status="old",
148 & form="unformatted",access="direct",recl=lenrec_ene(iprot))
151 do istart_conf=indstart(me1,iprot),indend(me1,iprot),maxstr_proc
152 iend_conf=min0(istart_conf+maxstr_proc-1,indend(me1,iprot))
154 do istart_conf=1,ntot_work(iprot),maxstr_proc
155 iend_conf=min0(istart_conf+maxstr_proc-1,ntot_work(iprot))
158 c Read the chunk of energies and derivatives off a DA scratchfile.
160 ipass_conf=ipass_conf+1
161 do i=1,ntot_work(iprot)
165 do i=istart_conf,iend_conf
170 write (iout,*) "ipass_conf",ipass_conf,
171 & " istart_conf",istart_conf," iend_conf",iend_conf
172 do i=1,ntot_work(iprot)
173 write (iout,*) "i",i," i2ii",i2ii(i,iprot)
177 call daread_ene(iprot,istart_conf,iend_conf)
184 c Put tohether all contributions.
189 c-------------------------------------------------------------------------------
190 subroutine ave_eval(iprot)
193 include "DIMENSIONS.ZSCOPT"
196 integer IERROR,ErrCode
200 include "COMMON.WEIGHTS"
201 include "COMMON.WEIGHTDER"
202 include "COMMON.ENERGIES"
203 include "COMMON.IOUNITS"
204 include "COMMON.VMCPAR"
205 include "COMMON.NAMES"
206 include "COMMON.INTERACT"
207 include "COMMON.TIME1"
208 include "COMMON.CHAIN"
209 include "COMMON.PROTFILES"
210 include "COMMON.THERMAL"
212 include "COMMON.CLASSES"
213 include "COMMON.COMPAR"
214 include "COMMON.TORSION"
215 include "COMMON.LOCAL"
216 include "COMMON.SCCOR"
217 include "COMMON.PROTNAME"
218 C Define local variables
219 integer i,ii,iii,jj,j,k,kk,l,ll,m,ik,jk,iprot,ib,inat,
223 integer ipass_conf,istart_conf,iend_conf
224 double precision energia(0:max_ene)
225 double precision etoti,sumpart,esquarei,emeani,
226 & elowesti,enepsjk,eprim,ebis,eprimi,ebisi,etoti_orig,
227 & entorjk,enangjk,eave_pft(max_ene),emix_pft(max_ene),
228 & esquare_ft,efree_t,emixsq_pft(max_ene),
229 & eneps_mixt(nntyp),eneps_meant(nntyp),
230 & enepsave_ft(nntyp),eneps_mix_ft(nntyp),
231 & eneps_mixsq_ft(nntyp),emean_ft
232 double precision aux,auxf,fac,facf,ef1,ef2,em1,em2,var1,var2,
233 & deltei,deltei_orig,temper,elowest_all
234 double precision gnmr,tcpu_ini,tcpu
235 double precision ftune_epsprim
236 external ftune_epsprim
242 C Compute the likelihood sum
243 DO IB=1,NBETA(1,IPROT)
244 elowest_all=elowest(ib,1,iprot)
246 write(csa_bank,'(a,f4.0,4hMlik,i4.4)')
247 & protname(iprot)(:ilen(protname(iprot))),
248 & 1.0d0/(0.001987*betaT(ib,1,iprot)),me
249 open (icsa_bank,file=csa_bank,status="unknown")
252 write(iout,*) "iprot",iprot," ib",ib,
253 & " elowest",elowest_l(ib,iprot)
255 fac=betaT(ib,1,iprot)
256 temper=1.0d0/(fac*Rgas)
258 sumlik(ib,iprot)=0.0d0
260 sumlikder(k,ib,iprot)=0.0d0
261 sumqder(k,ib,iprot)=0.0d0
263 do j=1,ntot_work(iprot)
266 if (i.gt.0) write (iout,*) "i",i," iprot",iprot,
267 & " indstart",indstart(me1,iprot),
268 & " indend",indend(me1,iprot)
273 c Temperature-dependent energy
276 etoti=etoti+ww(k)*escal(k,ib,1,iprot)
279 deltei=etoti-elowest(ib,1,iprot)
282 write (iout,*) "etoti",etoti," deltei",deltei
283 write (iout,'(20f8.3)')(ww(k)*escal(k,ib,1,iprot),k=1,n_ene)
284 write (iout,'(20f8.3)') (enetb(jj,k,iprot),
288 aux=entfac(i,iprot)+fac*deltei
289 sumlik(ib,iprot)=sumlik(ib,iprot)+aux*Ptab(jj,ib,iprot)
292 write (iout,'(2i5,f5.2,7(a,e15.5))')
293 & i,ib,fac," e_total",etoti,
294 & " eini",eini(i,iprot)," entfac",entfac(i,iprot),
295 & " e_lowest",elowest(ib,1,iprot)," aux",aux
296 write (iout,'(i5,5f12.5)')
297 & i,etoti,aux,dlog(Ptab(jj,ib,iprot)),rmstb(i,iprot),
298 & aux*Ptab(jj,ib,iprot)
302 write (icsa_bank,'(2i5,4f12.5,e15.5)')
303 & i,jj,etoti,aux,dlog(Ptab(jj,ib,iprot)),rmstb(i,iprot),
306 c write (iout,*)"jj",jj," enetb",(enetb(jj,k,iprot),k=1,n_ene)
308 sumlikder(k,ib,iprot)=sumlikder(k,ib,iprot)+
309 & +enetb(jj,k,iprot)*escal(k,ib,1,iprot)*Ptab(jj,ib,iprot)
315 sumlikeps(k,ib,iprot)=sumlikeps(k,ib,iprot)+
316 & (ftune_epsprim(eps(ik,jk))*
317 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot))
318 & *Ptab(jj,ib,iprot)*ww(1)
322 sumliktor(k,ib,iprot)=sumliktor(k,ib,iprot)
323 & +Ptab(jj,ib,iprot)*entor(k,jj,iprot)*escal(13,ib,1,iprot)
325 do k=nbacktor_var+1,ntor_var
326 sumliktor(k,ib,iprot)=sumliktor(k,ib,iprot)
327 & +Ptab(jj,ib,iprot)*entor(k,jj,iprot)*escal(19,ib,1,iprot)
330 c write (iout,*) "k=",k,enbend(k,jj,iprot),
331 c & escal(11,ib,1,iprot)
332 sumlikang(k,ib,iprot)=sumlikang(k,ib,iprot)
333 & +Ptab(jj,ib,iprot)*enbend(k,jj,iprot)*escal(11,ib,1,iprot)
335 if (aux.le.150.0) then
339 sumqder(k,ib,iprot)=sumqder(k,ib,iprot)
340 & +aux*enetb(jj,k,iprot)*escal(k,ib,1,iprot)
346 sumqeps(k,ib,iprot)=sumqeps(k,ib,iprot)+
347 & ww(1)*(ftune_epsprim(eps(ik,jk))*
348 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot))*aux
352 sumqtor(k,ib,iprot)=sumqtor(k,ib,iprot)
353 & +aux*entor(k,jj,iprot)*escal(13,ib,1,iprot)
355 do k=nbacktor_var+1,ntor_var
356 sumqtor(k,ib,iprot)=sumqtor(k,ib,iprot)
357 & +aux*entor(k,jj,iprot)*escal(19,ib,1,iprot)
360 sumqang(k,ib,iprot)=sumqang(k,ib,iprot)+
361 & aux*enbend(k,jj,iprot)*escal(11,ib,1,iprot)
367 efree(ib,1,iprot)=sumpart
369 write (iout,*) " ib",ib," iprot",iprot,
370 & " sumlik",sumlik(ib,iprot),
371 & " sumq",efree(ib,1,iprot)
377 C Calculation of heat capacity
378 DO IB=1,NBETA(2,IPROT)
379 elowest_all=elowest(ib,2,iprot)
381 write(iout,*) "iprot",iprot," ib",ib,
382 & " elowest",elowest(ib,2,iprot)
383 write(iout,*) "escalbis",(escalbis(k,ib,2,iprot),k=1,n_ene)
385 fac=betaT(ib,2,iprot)
386 temper=1.0d0/(fac*Rgas)
392 write (iout,*) "Before sum, ib=",ib
393 write (iout,*) "efree",efree(ib,2,iprot),sumpart,
394 & " emean",emean_ftot(ib,iprot),
395 & " esquare",esquare_ftot(ib,iprot),
396 & " ebis",ebis_ftot(ib,iprot),
397 & " emix_pfprim",(emix_pfprimtot(k,ib,iprot),k=1,n_ene)
399 do j=1,ntot_work(iprot)
402 if (i.gt.0) write (iout,*) "i",i," iprot",iprot,
403 & " indstart",indstart(me1,iprot),
404 & " indend",indend(me1,iprot)
410 write (iout,*) "ib",ib," j",j,
411 write (iout,*) "nu",(nu(k,jj,iprot),k=1,
416 c Temperature-dependent energy
422 etoti=etoti+ww(k)*escal(k,ib,2,iprot)
424 eprim=eprim+ww(k)*escalprim(k,ib,2,iprot)
426 ebis=ebis+ww(k)*escalbis(k,ib,2,iprot)
429 deltei=etoti-elowest(ib,2,iprot)
431 write (iout,*) "etoti",etoti," deltei",deltei
432 write (iout,'(20f8.3)') (ww(k),k=1,n_ene)
433 write (iout,'(20f8.3)') (enetb(jj,k,iprot),
436 aux=entfac(i,iprot)+fac*deltei
438 write (iout,'(f5.2,7(a,e15.5))')
439 & fac," e_total",etoti,
440 & " eini",eini(i,iprot)," entfac",entfac(i,iprot),
441 & " eprim",eprim," ebis",ebis,
442 & " e_lowest",elowest(ib,2,iprot)," aux",aux
444 if (aux.le.150.0) then
447 etoti=etoti-temper*eprim
448 emeani=emeani+etoti*aux
449 esquarei=esquarei+aux*etoti**2
452 eave_pftot(k,ib,iprot)=eave_pftot(k,ib,iprot)
453 & +aux*enetb(jj,k,iprot)*escal(k,ib,2,iprot)
454 c write (iout,*) "eave_pf",eave_pf(k,ii,ib,iprot)
455 eave_pfprimtot(k,ib,iprot)=eave_pfprimtot(k,ib,iprot)
456 & +aux*enetb(jj,k,iprot)*(escal(k,ib,2,iprot)-
457 & temper*escalprim(k,ib,2,iprot))
458 eave_pfbistot(k,ib,iprot)=eave_pfbistot(k,ib,iprot)
459 & +aux*enetb(jj,k,iprot)*escalbis(k,ib,2,iprot)
460 emix_pftot(k,ib,iprot)=emix_pftot(k,ib,iprot)
461 & +aux*enetb(jj,k,iprot)*etoti*escal(k,ib,2,iprot)
462 emix_pfprimtot(k,ib,iprot)=emix_pfprimtot(k,ib,iprot)
463 & +aux*enetb(jj,k,iprot)*etoti*(escal(k,ib,2,iprot)
464 & -temper*escalprim(k,ib,2,iprot))
465 emix_pfbistot(k,ib,iprot)=emix_pfbistot(k,ib,iprot)
466 & +aux*enetb(jj,k,iprot)*ebis*escal(k,ib,2,iprot)
467 emixsq_pftot(k,ib,iprot)=emixsq_pftot(k,ib,iprot)
468 & +aux*enetb(jj,k,iprot)*etoti**2*escal(k,ib,2,iprot)
474 enepsjk=ftune_epsprim(eps(ik,jk))*
475 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot)
476 enepsjk=enepsjk*ww(1)
477 enepsave_ftot(k,ib,iprot)=enepsave_ftot(k,ib,iprot)
479 eneps_mix_ftot(k,ib,iprot)=
480 & eneps_mix_ftot(k,ib,iprot)+aux*enepsjk*etoti
481 eneps_mix_fbistot(k,ib,iprot)=
482 & eneps_mix_fbistot(k,ib,iprot)+aux*enepsjk*ebis
483 eneps_mixsq_ftot(k,ib,iprot)=
484 & eneps_mixsq_ftot(k,ib,iprot)+aux*enepsjk*etoti**2
488 entorjk=entor(k,jj,iprot)
489 c write (iout,*) " k"," ik",ik," jk",jk,
490 c & " entor",entorjk," contirb",
491 c & aux*entorjk*escal(13,ib,2,iprot)
492 entorave_ftot(k,ib,iprot)=
493 & entorave_ftot(k,ib,iprot)
494 & +aux*entorjk*escal(13,ib,2,iprot)
495 c write (iout,*) "entorave_f",
496 c & entorave_ftot(k,ib,iprot)
497 entorave_fprimtot(k,ib,iprot)=
498 & entorave_fprimtot(k,ib,iprot)
499 & +aux*entorjk*(escal(13,ib,2,iprot)-
500 & temper*escalprim(13,ib,2,iprot))
501 entorave_fbistot(k,ib,iprot)=
502 & entorave_fbistot(k,ib,iprot)
503 & +aux*entorjk*escalbis(13,ib,2,iprot)
504 entor_mix_ftot(k,ib,iprot)=
505 & entor_mix_ftot(k,ib,iprot)
506 & +aux*entorjk*etoti*escal(13,ib,2,iprot)
507 entor_mix_fprimtot(k,ib,iprot)=
508 & entor_mix_fprimtot(k,ib,iprot)
509 & +aux*entorjk*etoti*(escal(13,ib,2,iprot)-
510 & temper*escalprim(13,ib,2,iprot))
511 entor_mix_fbistot(k,ib,iprot)=
512 & entor_mix_fbistot(k,ib,iprot)
513 & +aux*entorjk*ebis*escal(13,ib,2,iprot)
514 entor_mixsq_ftot(k,ib,iprot)=
515 & entor_mixsq_ftot(k,ib,iprot)
516 & +aux*entorjk*etoti**2*escal(13,ib,2,iprot)
518 do k=nbacktor_var+1,ntor_var
519 entorjk=entor(k,jj,iprot)
520 c write (iout,*) " k"," ik",ik," jk",jk,
521 c & " entor",entorjk," contirb",
522 c & aux*entorjk*escal(19,ib,2,iprot)
523 entorave_ftot(k,ib,iprot)=
524 & entorave_ftot(k,ib,iprot)
525 & +aux*entorjk*escal(19,ib,2,iprot)
526 c write (iout,*) "entorave_f",
527 c & entorave_ftot(k,ib,iprot)
528 entorave_fprimtot(k,ib,iprot)=
529 & entorave_fprimtot(k,ib,iprot)
530 & +aux*entorjk*(escal(19,ib,2,iprot)-
531 & temper*escalprim(19,ib,2,iprot))
532 entorave_fbistot(k,ib,iprot)=
533 & entorave_fbistot(k,ib,iprot)
534 & +aux*entorjk*escalbis(19,ib,2,iprot)
535 entor_mix_ftot(k,ib,iprot)=
536 & entor_mix_ftot(k,ib,iprot)
537 & +aux*entorjk*etoti*escal(19,ib,2,iprot)
538 entor_mix_fprimtot(k,ib,iprot)=
539 & entor_mix_fprimtot(k,ib,iprot)
540 & +aux*entorjk*etoti*(escal(19,ib,2,iprot)-
541 & temper*escalprim(13,ib,2,iprot))
542 entor_mix_fbistot(k,ib,iprot)=
543 & entor_mix_fbistot(k,ib,iprot)
544 & +aux*entorjk*ebis*escal(19,ib,2,iprot)
545 entor_mixsq_ftot(k,ib,iprot)=
546 & entor_mixsq_ftot(k,ib,iprot)
547 & +aux*entorjk*etoti**2*escal(19,ib,2,iprot)
550 enangjk=enbend(k,jj,iprot)
551 c write (iout,*) " k"," ik",ik," jk",jk,
552 c & " entor",entorjk," contirb",
553 c & aux*entorjk*escal(13,ib,2,iprot)
554 enangave_ftot(k,ib,iprot)=
555 & enangave_ftot(k,ib,iprot)
556 & +aux*enangjk*escal(11,ib,2,iprot)
557 enang_mix_ftot(k,ib,iprot)=
558 & enang_mix_ftot(k,ib,iprot)
559 & +aux*enangjk*etoti*escal(11,ib,2,iprot)
560 enang_mixsq_ftot(k,ib,iprot)=
561 & enang_mixsq_ftot(k,ib,iprot)
562 & +aux*enangjk*etoti**2*escal(11,ib,2,iprot)
567 efree(ib,2,iprot)=sumpart
568 emean_ftot(ib,iprot)=emeani
569 ebis_ftot(ib,iprot)=ebisi
570 esquare_ftot(ib,iprot)=esquarei
572 write (iout,*) "After sum, ib=",ib
573 write (iout,*) "efree",efree(ib,2,iprot),sumpart,
574 & " emean",emean_ftot(ib,iprot),
575 & " esquare",esquare_ftot(ib,iprot),
576 & " ebis",ebis_ftot(ib,iprot),
577 & " emix_pfprim",(emix_pfprimtot(k,ib,iprot),k=1,n_ene)
579 ebis_ftot(ib,iprot)=ebis_ftot(ib,iprot)*temper
581 eave_pfbistot(k,ib,iprot)=
582 & eave_pfbistot(k,ib,iprot)*temper
583 emix_pfbistot(k,ib,iprot)=
584 & emix_pfbistot(k,ib,iprot)*temper
587 eneps_mix_fbistot(k,ib,iprot)=
588 & eneps_mix_fbistot(k,ib,iprot)*temper
591 entorave_fbistot(k,ib,iprot)=
592 & entorave_fbistot(k,ib,iprot)*temper
593 entor_mix_fbistot(k,ib,iprot)=
594 & entor_mix_fbistot(k,ib,iprot)*temper
597 write (iout,*) "eave_pf",(eave_pftot(k,ib,iprot),
599 write (iout,*) "entorave_f",(entorave_ftot(k,ib,iprot),
603 write (iout,*) "ib",ib," temper",temper,
604 & " ebis",ebis_ftot(ib,iprot)
607 C Calculation of conformation-dependent averages
608 DO INAT=1,NATLIKE(IPROT)
609 DO IB=1,NBETA(I+2,IPROT)
610 elowest_all=elowest(ib,inat+2,iprot)
612 write(iout,*) "iprot",iprot," ib",ib,
613 & " elowest",elowest(ib,iprot)
615 fac=betaT(ib,2,iprot)
616 temper=1.0d0/(fac*Rgas)
618 do j=1,ntot_work(iprot)
621 if (i.gt.0) write (iout,*) "i",i," iprot",iprot,
622 & " indstart",indstart(me1,iprot),
623 & " indend",indend(me1,iprot)
629 write (iout,*) "ib",ib," j",j,
630 write (iout,*) "nu",(nu(k,jj,iprot),k=1,
635 c Temperature-dependent energy
638 etoti=etoti+ww(k)*escal(k,ib,inat+2,iprot)
641 deltei=etoti-elowest(ib,inat+2,iprot)
643 write (iout,*) "etoti",etoti," deltei",deltei
644 write (iout,'(20f8.3)') (ww(k),k=1,n_ene)
645 write (iout,'(20f8.3)') (enetb(jj,k,iprot),
648 aux=entfac(i,iprot)+fac*deltei
650 write (iout,'(f5.2,7(a,e15.5))')
651 & fac," e_total",etoti,
652 & " eini",eini(i,iprot)," entfac",entfac(i,iprot),
653 & " eprim",eprim," ebis",ebis,
654 & " e_lowest",elowest(ib,inat+2,iprot)," aux",aux
656 if (aux.le.150.0) then
659 c 4/13/04 AL Components of the conformation-dependent averages
661 eave_nat_pftot(k,ib,inat,iprot)=
662 & eave_nat_pftot(k,ib,inat,iprot)
663 & +aux*enetb(jj,k,iprot)*escal(k,ib,inat+2,iprot)
669 enepsjk=ftune_epsprim(eps(ik,jk))*
670 & eneps(1,k,jj,iprot)+eneps(2,k,jj,iprot)
671 enepsjk=enepsjk*ww(1)
672 enepsave_nat_ftot(k,ib,inat,iprot)=
673 & enepsave_nat_ftot(k,ib,inat,iprot)
679 entorjk=entor(k,jj,iprot)
680 c write (iout,*) " k",
681 c & " entor",entorjk," contirb",
682 c & aux*entorjk*escal(13,ib,inat+2,iprot)
683 entorave_nat_ftot(k,ib,inat,iprot)=
684 & entorave_nat_ftot(k,ib,inat,iprot)
685 & +aux*entorjk*escal(13,ib,inat+2,iprot)
687 do k=nbacktor_var+1,ntor_var
689 entorjk=entor(k,jj,iprot)
690 c write (iout,*) " k",
691 c & " entor",entorjk," contirb",
692 c & aux*entorjk*escal(19,ib,inat+2,iprot)
693 entorave_nat_ftot(k,ib,inat,iprot)=
694 & entorave_nat_ftot(k,ib,inat,iprot)
695 & +aux*entorjk*escal(19,ib,inat+2,iprot)
699 enangjk=enang(k,jj,iprot)
700 c write (iout,*) " k",
701 c & " entor",entorjk," contirb",
702 c & aux*entorjk*escal(13,ib,inat+2,iprot)
703 enangave_nat_ftot(k,ib,inat,iprot)=
704 & enangave_nat_ftot(k,ib,inat,iprot)
705 & +aux*enangjk*escal(11,ib,inat+2,iprot)
707 do l=1,natdim(inat,iprot)
708 nuave(l,ib,inat,iprot)=nuave(l,ib,inat,iprot)
709 & +aux*nu(l,inat,jj,iprot)
711 nu_pf(k,l,ib,inat,iprot)=nu_pf(k,l,ib,inat,iprot)
712 & +aux*enetb(jj,k,iprot)*nu(k,inat,jj,iprot)*
713 & escal(k,ib,inat+2,iprot)
719 nuepsave_f(k,l,ib,inat,iprot)=
720 & nuepsave_f(k,l,ib,inat,iprot)+aux*enepsjk*
721 & nu(l,inat,jj,iprot)
726 do jk=-ntortyp,ntortyp
728 if (mask_tor(0,jk,ik,iblock).gt.0) then
730 nutorave_f(k,l,ib,inat,iprot)=
731 & nutorave_f(k,l,ib,inat,iprot)
732 & +aux*entorjk*escal(13,ib,inat+2,iprot)*
733 & nu(l,inat,jj,iprot)
741 if (mask_tor(ll,jk,ik,1).gt.0) then
743 nutorave_f(k,l,ib,inat,iprot)=
744 & nutorave_f(k,l,ib,inat,iprot)
745 & +aux*entorjk*escal(13,ib,inat+2,iprot)*
746 & nu(l,inat,jj,iprot)
753 if (mask_ang(ik).gt.0) then
755 nuangave_f(k,l,ib,inat,iprot)=
756 & nuangave_f(k,l,ib,inat,iprot)
757 & +aux*enangjk*escal(11,ib,inat+2,iprot)*
758 & nu(l,inat,jj,iprot)
765 write (iout,*) "iprot",iprot," ib",ib,
766 write (iout,*) "nuave"
767 write (iout,'(20f10.5)') (nuave(k,ib,iprot),
768 & k=1,natconstr(iprot))
771 write (iout,*) "inat",inat,
772 & " efree_nat",efree_nat(ib,inat,iprot)
776 write (iout,*) "iprot",iprot," ib",ib
777 write (iout,*) "nuave0"
778 write (iout,'(20f10.5)') (nuave(k,ib,inat,iprot),
779 & k=1,natdim(inat,iprot))
785 c-------------------------------------------------------------------------------
786 subroutine ave_sum(iprot)
789 include "DIMENSIONS.ZSCOPT"
792 integer IERROR,ErrCode
796 include "COMMON.WEIGHTS"
797 include "COMMON.WEIGHTDER"
798 include "COMMON.ENERGIES"
799 include "COMMON.IOUNITS"
800 include "COMMON.VMCPAR"
801 include "COMMON.NAMES"
802 include "COMMON.INTERACT"
803 include "COMMON.TIME1"
804 include "COMMON.CHAIN"
805 include "COMMON.PROTFILES"
807 include "COMMON.COMPAR"
808 C Define local variables
809 integer i,ii,iii,jj,j,k,l,ik,jk,iprot,ib,inat
810 integer ipass_conf,istart_conf,iend_conf
811 double precision energia(0:max_ene)
812 double precision etoti,sumpart,esquarei,emeani,elowesti,enepsjk,
813 & eave_pft(max_ene),emix_pft(max_ene),eave_pfprimt(max_ene),
814 & eave_pfbist(max_ene),emix_pfprimt(max_ene),emix_pfbist(max_ene),
815 & esquare_ft,efree_t,
816 & emixsq_pft(max_ene),eneps_mixt(nntyp),eneps_meant(nntyp),
817 & enepsave_ft(nntyp),eneps_mix_ft(nntyp),entorave_ft(maxtor_var),
818 & entor_mix_ft(maxtor_var),
819 & enangave_ft(maxang_var),enang_mix_ft(maxang_var),
820 & eneps_mix_fbist(nntyp),entorave_fbist(maxtor_var),
821 & entorave_fprimt(maxtor_var),entor_mix_fprimt(maxtor_var),
822 & entor_mix_fbist(maxtor_var),eneps_mixsq_ft(nntyp),
823 & entor_mixsq_ft(maxtor_var),emean_ft,ebis_ft,nuave_t(maxdimnat),
824 & enang_mixsq_ft(maxang_var),nu_pft(max_ene,maxdimnat),
825 & nuepsave_ft(nntyp,maxdimnat),
826 & nutorave_ft(maxtor_var,maxdimnat),
827 & nuangave_ft(maxang_var,maxdimnat),
828 & sumlik_t,sumlikder_t(max_ene),sumlikeps_t(nntyp),
829 & sumliktor_t(maxtor_var),
830 & sumlikang_t(maxang_var),
831 & sumq_t,sumqder_t(max_ene),sumqeps_t(nntyp),
832 & sumqtor_t(maxtor_var),
833 & sumqang_t(maxang_var)
835 double precision aux,fac,ef1,ef2,em1,em2,var1,var2,efree_tot,facF,
837 double precision gnmr,tcpu_ini,tcpu
841 integer ind_shield /25/
844 c Maximum likelihood contribution
845 DO IB=1,NBETA(1,IPROT)
846 fac=betaT(ib,1,iprot)
849 write (iout,*) "Processor",me,me1," calling MPI_Reduce: 3"
850 write (iout,*) "iprot",iprot," ib",ib
851 write (iout,*) "sumlik",sumlik(ib,iprot),
852 & " sumq",efree(ib,1,iprot)
855 call MPI_Reduce( sumlik(ib,iprot), sumlik_t,1,
856 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
857 call MPI_Reduce( efree(ib,1,iprot), sumq_t,1,
858 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
860 write (iout,*) "sumlik",sumlik(ib,iprot)," sumlik_t",sumlik_t
861 write (iout,*) "sumq",efree(ib,1,iprot)," sumq_t",sumq_t
864 call MPI_Reduce(sumlikder(1,ib,iprot),sumlikder_t(1),
866 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
867 call MPI_Reduce(sumlikeps(1,ib,iprot),
868 & sumlikeps_t(1), nntyp,
869 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
870 call MPI_Reduce(sumliktor(1,ib,iprot),
871 & sumliktor_t(1), ntor_var,
872 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
873 call MPI_Reduce(sumlikang(1,ib,iprot),
874 & sumlikang_t(1), nang_var,
875 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
876 call MPI_Reduce(sumqder(1,ib,iprot),sumqder_t(1),n_ene,
877 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
878 call MPI_Reduce(sumqeps(1,ib,iprot),sumqeps_t(1), nntyp,
879 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
880 call MPI_Reduce(sumqtor(1,ib,iprot),sumqtor_t(1), ntor_var,
881 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
882 call MPI_Reduce(sumqang(1,ib,iprot),sumqang_t(1), nang_var,
883 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
885 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 3"
888 if (me1.eq.master) then
891 write (iout,*) "ib",ib,
892 & " elowest",elowest(ib,1,iprot),
893 & " sumlik",sumlik_t," qsum",sumq_t," fac",fac
897 sumlikder(k,ib,iprot)=fac*(
899 & -sumqder_t(k)/sumq_t)
902 sumlikeps(k,ib,iprot)=fac*(
903 & sumlikeps_t(k)-sumqeps_t(k)/sumq_t)
905 c write (iout,*) "eavetor",eave_pftot(13,ib,iprot),
906 c & eave_pftot(19,ib,iprot)
908 sumliktor(k,ib,iprot)=fac*(
909 & sumliktor_t(k)-sumqtor_t(k)/sumq_t)
912 sumlikang(k,ib,iprot)=fac*(
913 & sumlikang_t(k)-sumqang_t(k)/sumq_t)
915 sumlik(ib,iprot)=sumlik_t+dlog(sumq_t)
916 efree(ib,1,iprot)=sumq_t
918 write (iout,*) "ib",ib," iprot",iprot," final sumlik",
919 & sumlik(ib,iprot)," sumq",efree(ib,1,iprot)
920 write (iout,*) "sumlikder",sumlikder(1:n_ene,ib,iprot)
925 sumlikder(k,ib,iprot)=fac*(
926 & sumlikder(k,ib,iprot)
927 & -sumqder(k,ib,iprot)/efree(ib,1,iprot))
930 sumlikeps(k,ib,iprot)=fac*(
931 & sumlikeps(k,ib,iprot)
932 & -sumqeps(k,ib,iprot)/efree(ib,1,iprot))
935 sumliktor(k,ib,iprot)=fac*(
936 & sumliktor(k,ib,iprot)
937 & -sumqtor(k,ib,iprot)/efree(ib,1,iprot))
940 sumlikang(k,ib,iprot)=fac*(
941 & sumlikang(k,ib,iprot)
942 & -sumqang(k,ib,iprot)/efree(ib,1,iprot))
944 sumlik(ib,iprot)=sumlik(ib,iprot)+dlog(efree(ib,1,iprot)
945 c & -elowest(nbeta(iprot)+ib,iprot)*fac
949 if (imask(k).gt.0 .and. k.ne.ind_shield) then
951 sumlikder(ii,ib,iprot)=sumlikder(k,ib,iprot)
955 c Heat capacity and averages
956 DO IB=1,NBETA(2,IPROT)
957 fac=betaT(ib,2,iprot)
960 write (iout,*) "Processor",me,me1," calling MPI_Reduce: 3"
961 write (iout,*) "iprot",iprot," ib",ib
964 call MPI_Reduce( efree(ib,2,iprot), efree_t,1,
965 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
967 write (iout,*) "efree",efree(iprot
968 write (iout,*) "efree_t",efree_t
971 call MPI_Reduce(emean_ftot(ib,iprot),emean_ft,1,
972 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
973 call MPI_Reduce(ebis_ftot(ib,iprot),ebis_ft,1,
974 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
975 call MPI_Reduce(esquare_ftot(ib,iprot),esquare_ft,1,
976 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
977 call MPI_Reduce(eave_pftot(1,ib,iprot),eave_pft,
979 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
980 call MPI_Reduce(eave_pfprimtot(1,ib,iprot),
981 & eave_pfprimt,n_ene,
982 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
983 call MPI_Reduce(eave_pfbistot(1,ib,iprot),
985 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
986 c write (iout,*) "eave_pf",(eave_pf(k,iprot),
988 c write (iout,*) "eave_pft",(eave_pft(k),k=1,n_ene)
989 call MPI_Reduce(emix_pftot(1,ib,iprot),emix_pft,
991 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
992 call MPI_Reduce(emix_pfprimtot(1,ib,iprot),
993 & emix_pfprimt,n_ene,
994 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
995 call MPI_Reduce(emix_pfbistot(1,ib,iprot),
997 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
998 call MPI_Reduce(emixsq_pftot(1,ib,iprot),
1000 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1001 call MPI_Reduce(enepsave_ftot(1,ib,iprot),
1002 & enepsave_ft, nntyp,
1003 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1004 call MPI_Reduce(eneps_mix_ftot(1,ib,iprot),
1005 & eneps_mix_ft,nntyp,
1006 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1007 call MPI_Reduce(eneps_mix_fbistot(1,ib,iprot),
1008 & eneps_mix_fbist,nntyp,
1009 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1010 call MPI_Reduce(eneps_mixsq_ftot(1,ib,iprot),
1011 & eneps_mixsq_ft,nntyp,
1012 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1013 c write (iout,*) "enepsave_f",(enepsave_f(k,iprot),
1015 c write (iout,*) "enepsave_ft",(enepsave_ft(k),
1017 call MPI_Reduce(entorave_ftot(1,ib,iprot),
1018 & entorave_ft, ntor_var,
1019 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1020 call MPI_Reduce(entorave_fprimtot(1,ib,iprot),
1021 & entorave_fprimt, ntor_var,
1022 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1023 call MPI_Reduce(entorave_fbistot(1,ib,iprot),
1024 & entorave_fbist, ntor_var,
1025 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1026 call MPI_Reduce(entor_mix_ftot(1,ib,iprot),
1027 & entor_mix_ft,ntor_var,
1028 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1029 call MPI_Reduce(entor_mix_fprimtot(1,ib,iprot),
1030 & entor_mix_fprimt,ntor_var,
1031 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1032 call MPI_Reduce(entor_mix_fbistot(1,ib,iprot),
1033 & entor_mix_fbist,ntor_var,
1034 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1035 call MPI_Reduce(entor_mixsq_ftot(1,ib,iprot),
1036 & entor_mixsq_ft,ntor_var,
1037 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1038 c write (iout,*) "entorave_f",(entorave_f(k,iprot),
1040 c write (iout,*) "entorave_ft",(entorave_ft(k),
1042 call MPI_Reduce(enangave_ftot(1,ib,iprot),
1043 & enangave_ft, nang_var,
1044 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1045 call MPI_Reduce(enang_mix_ftot(1,ib,iprot),
1046 & enang_mix_ft,ntor_var,
1047 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1048 call MPI_Reduce(enang_mixsq_ftot(1,ib,iprot),
1049 & enang_mixsq_ft,ntor_var,
1050 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1052 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 3"
1055 if (me1.eq.master) then
1056 elowest_all=elowest(ib,2,iprot)
1058 write (iout,*) "ib",ib,
1059 & " elowest",elowest(ib,iprot),
1060 & "efree",efree_t," fac",fac," facF",facF,
1061 & " efree_tot",efree_tot
1064 eave_pftot(k,ib,iprot)=eave_pft(k)/efree_t
1065 eave_pfprimtot(k,ib,iprot)=eave_pfprimt(k)/efree_t
1066 eave_pfbistot(k,ib,iprot)=eave_pfbist(k)/efree_t
1067 emix_pftot(k,ib,iprot)=emix_pft(k)/efree_t
1068 emix_pfprimtot(k,ib,iprot)=emix_pfprimt(k)/efree_t
1069 emix_pfbistot(k,ib,iprot)=emix_pfbist(k)/efree_t
1070 emixsq_pftot(k,ib,iprot)=emixsq_pft(k)/efree_t
1073 enepsave_ftot(k,ib,iprot)=enepsave_ft(k)/efree_t
1074 eneps_mix_ftot(k,ib,iprot)=eneps_mix_ft(k)/efree_t
1075 eneps_mix_fbistot(k,ib,iprot)=eneps_mix_fbist(k)/efree_t
1076 eneps_mixsq_ftot(k,ib,iprot)=eneps_mixsq_ft(k)/efree_t
1078 c write (iout,*) "eavetor",eave_pftot(13,ib,iprot),
1079 c & eave_pftot(19,ib,iprot)
1081 entorave_ftot(k,ib,iprot)=entorave_ft(k)/
1083 c write (iout,*) "iprot",iprot," ib",ib," k",k,
1084 c & " entorave_ftot", entorave_ftot(k,ib,iprot)
1085 entorave_fprimtot(k,ib,iprot)=entorave_fprimt(k)/efree_t
1086 entorave_fbistot(k,ib,iprot)=entorave_fbist(k)/efree_t
1087 entor_mix_ftot(k,ib,iprot)=entor_mix_ft(k)/efree_t
1088 entor_mix_fprimtot(k,ib,iprot)=entor_mix_fprimt(k)/efree_t
1089 entor_mix_fbistot(k,ib,iprot)=entor_mix_fbist(k)/efree_t
1090 entor_mixsq_ftot(k,ib,iprot)=entor_mixsq_ft(k)/efree_t
1093 enangave_ftot(k,ib,iprot)=enangave_ft(k)/
1095 c write (iout,*) "iprot",iprot," ib",ib," k",k,
1096 c & " entorave_ftot", entorave_ftot(k,ib,iprot)
1097 enang_mix_ftot(k,ib,iprot)=enang_mix_ft(k)/efree_t
1098 enang_mixsq_ftot(k,ib,iprot)=enang_mixsq_ft(k)/efree_t
1100 emean_ftot(ib,iprot)=emean_ft/efree_t
1101 ebis_ftot(ib,iprot)=ebis_ft/efree_t
1102 esquare_ftot(ib,iprot)=esquare_ft/efree_t
1103 efree(ib,2,iprot)=-dlog(efree_t)/fac+elowest(ib,2,iprot)
1107 eave_pftot(k,ib,iprot)=eave_pftot(k,ib,iprot)
1108 & /efree(ib,2,iprot)
1109 eave_pfprimtot(k,ib,iprot)=eave_pfprimtot(k,ib,iprot)
1110 & /efree(ib,2,iprot)
1111 eave_pfbistot(k,ib,iprot)=eave_pfbistot(k,ib,iprot)
1112 & /efree(ib,2,iprot)
1113 emix_pftot(k,ib,iprot)=emix_pftot(k,ib,iprot)/efree(ib,iprot)
1114 emix_pfprimtot(k,ib,iprot)=emix_pfprimtot(k,ib,iprot)
1115 & /efree(ib,2,iprot)
1116 emix_pfbistot(k,ib,iprot)=emix_pfbistot(k,ib,iprot)
1117 & /efree(ib,2,iprot)
1118 emixsq_pftot(k,ib,iprot)=emixsq_pftot(k,ib,iprot)
1119 & /efree(ib,2,iprot)
1122 enepsave_ftot(k,ib,iprot)=enepsave_ftot(k,ib,iprot)
1123 & /efree(ib,2,iprot)
1124 eneps_mix_ftot(k,ib,iprot)=eneps_mix_ftot(k,ib,iprot)
1125 & /efree(ib,2,iprot)
1126 eneps_mixsq_ftot(k,ib,iprot)=eneps_mixsq_ftot(k,ib,iprot)
1127 & /efree(ib,2,iprot)
1130 entorave_ftot(k,ib,iprot)=entorave_f(k,ib,iprot)
1131 & /efree(ib,2,iprot)
1132 entor_mix_ftot(k,ib,iprot)=entor_mix_ftot(k,ib,iprot)
1133 & /efree(ib,2,iprot)
1134 entor_mixsq_ftot(k,ib,iprot)=entor_mixsq_ftot(k,ib,iprot)
1135 & /efree(ib,2,iprot)
1138 enangave_ftot(k,ib,iprot)=enangave_f(k,ib,iprot)
1139 & /efree(ib,2,iprot)
1140 enang_mix_ftot(k,ib,iprot)=enang_mix_ftot(k,ib,iprot)
1141 & /efree(ib,2,iprot)
1142 enang_mixsq_ftot(k,ib,iprot)=enang_mixsq_ftot(k,ib,iprot)
1143 & /efree(ib,2,iprot)
1145 emean_ftot(ib,iprot)=emean_ftot(ib,iprot)/efree(ib,2,iprot)
1146 ebis_ftot(ib,iprot)=ebis_ftot(ib,iprot)/efree(ib,2,iprot)
1147 esquare_ftot(ib,iprot)=esquare_ftot(ib,iprot)/efree(ib,2,iprot)
1150 c 4/13/04 AL Components of the correlation coefficients and their derivatives
1151 DO INAT=1,NATLIKE(IPROT)
1152 DO IB=1,NBETA(INAT+2,IPROT)
1154 call MPI_Reduce( efree(ib,inat+2,iprot), efree_t,1,
1155 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1156 call MPI_Reduce( eave_nat_pftot(1, ib,inat,iprot), eave_pft,
1158 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1159 call MPI_Reduce( enepsave_nat_ftot(1, ib,inat,iprot),
1160 & enepsave_ft, nntyp,
1161 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1162 call MPI_Reduce(entorave_nat_ftot(1,ib,inat,iprot),
1163 & entorave_ft, ntor_var,
1164 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1165 call MPI_Reduce(enangave_nat_ftot(1,ib,inat,iprot),
1166 & enangave_ft, nang_var,
1167 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, Comm1, IERROR)
1168 call MPI_Reduce(nuave(1,ib,inat,iprot),nuave_t(1),
1169 & natdim(inat,iprot), MPI_DOUBLE_PRECISION, MPI_SUM,
1170 & Master, Comm1, IERROR)
1172 write (iout,*) "After REDUCE nuave",iprot,ib
1173 write (iout,'(20f10.5)')
1174 & (nuave(l,ib,iprot),l=1,natconstr(iprot))
1176 call MPI_Reduce(nu_pf(1,1,ib,inat,iprot),nu_pft(1,1),
1177 & max_ene*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1178 & MPI_SUM, Master, Comm1, IERROR)
1179 call MPI_Reduce(nuepsave_f(1,1,ib,inat,iprot),
1181 & nntyp*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1182 & MPI_SUM, Master, Comm1, IERROR)
1183 call MPI_Reduce(nutorave_f(1,1,ib,inat,iprot),
1185 & maxtor_var*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1186 & MPI_SUM, Master, Comm1, IERROR)
1187 call MPI_Reduce(nuangave_f(1,1,ib,inat,iprot),
1189 & maxang_var*natdim(inat,iprot), MPI_DOUBLE_PRECISION,
1190 & MPI_SUM, Master, Comm1, IERROR)
1192 write (iout,*) "Processor",me,me1," finished MPI_Reduce: 3"
1195 if (me1.eq.master) then
1197 write (iout,*) "ib",ib,
1198 & " elowest",elowest(ib,iprot),
1199 & "efree",efree_t," fac",fac,
1200 & " efree_tot",efree_tot
1202 do l=1,natdim(inat,iprot)
1204 nu_pf(k,l,ib,inat,iprot)=nu_pft(k,l)/efree_t
1207 nuepsave_f(k,l,ib,inat,iprot)=nuepsave_ft(k,l)/efree_t
1210 nutorave_f(k,l,ib,inat,iprot)=nutorave_ft(k,l)/efree_t
1213 nuangave_f(k,l,ib,inat,iprot)=nuangave_ft(k,l)/efree_t
1215 nuave(l,ib,inat,iprot)=nuave_t(l)/efree_t
1218 eave_nat_pftot(k,ib,inat,iprot)=eave_pft(k)/efree_t
1221 enepsave_nat_ftot(k,ib,inat,iprot)=enepsave_ft(k)/efree_t
1224 entorave_nat_ftot(k,ib,inat,iprot)=entorave_ft(k)/efree_t
1227 enangave_nat_ftot(k,ib,inat,iprot)=enangave_ft(k)/efree_t
1231 do l=1,natdim(inat,iprot)
1233 nu_pf(k,l,ib,inat,iprot)=nu_pf(k,l,ib,inat,iprot)
1234 & /efree(ib,inat+2,iprot)
1237 nuepsave_f(k,l,ib,inat,iprot)=nuepsave_f(k,l,ib,inat,iprot)
1238 & /efree(ib,inat+2,iprot)
1241 nutorave_ftot(k,l,ib,inat,iprot)=
1242 & nutorave_ftot(k,l,ib,inat,iprot)
1243 & /efree(ib,inat+2,iprot)
1246 nuangave_ftot(k,l,ib,inat,iprot)=
1247 & nuangave_ftot(k,l,ib,inat,iprot)
1248 & /efree(ib,inat+2,iprot)
1250 nuave(l,ib,inat,iprot)=nuave(l,ib,inat,iprot)
1251 & /efree(ib,inat+2,iprot)
1254 eave_nat_pftot(k,ib,inat,iprot)=
1255 & eave_nat_pftot(k,ib,inat,iprot)
1256 & /efree(ib,inat+2,iprot)
1259 enepsave_nat_ftot(k,ib,inat,iprot)=
1260 & enepsave_nat_ftot(k,ib,inat,iprot)/efree(ib,inat+2,iprot)
1263 enetorave_nat_ftot(k,ib,inat,iprot)=
1264 & enetorave_nat_ftot(k,ib,inat,iprot)/efree(ib,inat+2,iprot)
1267 eneangave_nat_ftot(k,ib,inat,iprot)=
1268 & eneangave_nat_ftot(k,ib,inat,iprot)/efree(ib,inat+2,iprot)
1273 write (iout,*) "ib",ib," efree_tot",efree_tot