correction for idihconstr_end_homo, no differ in wham now
[unres.git] / source / cluster / wham / src-M / srtclust.f
1       SUBROUTINE SRTCLUST(ICUT,NCON,IB)
2       implicit real*8 (a-h,o-z)
3       include 'DIMENSIONS'
4       include 'sizesclu.dat'
5       include 'COMMON.CLUSTER'
6       include 'COMMON.FREE'
7       include 'COMMON.IOUNITS'
8       double precision prob(maxgr)
9 c
10 c Compute free energies of clusters
11 c
12       do igr=1,ngr
13       emin=totfree(nconf(igr,1))
14       totfree_gr(igr)=1.0d0
15       do i=2,licz(igr)
16         ii=nconf(igr,i)
17         totfree_gr(igr)=totfree_gr(igr)+dexp(-totfree(ii)+emin)
18       enddo
19 c      write (iout,*) "igr",igr," totfree",emin,
20 c     &    " totfree_gr",totfree_gr(igr)
21       totfree_gr(igr)=emin-dlog(totfree_gr(igr))
22 c      write (iout,*) igr," efree",totfree_gr(igr)/beta_h(ib)
23       enddo
24 C
25 C  SORT CONFORMATIONS IN GROUPS ACC. TO ENERGY
26 C
27       DO 16 IGR=1,NGR
28       LIGR=LICZ(IGR)
29       DO 17 ICO=1,LIGR-1
30       IND1=NCONF(IGR,ICO)
31       ENE=totfree(IND1)
32       DO 18 JCO=ICO+1,LIGR
33       IND2=NCONF(IGR,JCO)
34       EN1=totfree(IND2)
35       IF (EN1.LT.ENE) THEN
36         NCONF(IGR,ICO)=IND2
37         NCONF(IGR,JCO)=IND1
38         IND1=IND2
39         ENE=EN1
40       ENDIF
41    18 CONTINUE
42    17 CONTINUE
43    16 CONTINUE
44 C
45 C  SORT GROUPS
46 C
47       DO 71 IGR=1,NGR
48       ENE=totfree_gr(IGR)
49       DO 72 JGR=IGR+1,NGR
50       EN1=totfree_gr(JGR)
51       IF (EN1.LT.ENE) THEN
52         LI1=LICZ(IGR)
53         LI2=LICZ(JGR)
54         LI=MAX0(LI1,LI2)
55         DO 73 I=1,LI   
56         NCO=NCONF(IGR,I)
57         NCONF(IGR,I)=NCONF(JGR,I)
58         NCONF(JGR,I)=NCO
59    73   CONTINUE
60         totfree_gr(igr)=en1
61         totfree_gr(jgr)=ene
62         ENE=EN1
63         LICZ(IGR)=LI2
64         LICZ(JGR)=LI1
65       ENDIF
66    72 CONTINUE
67    71 CONTINUE
68       write (iout,'("Free energies and probabilities of clusters at",
69      &   f6.1," K")') 1.0d0/(1.987d-3*beta_h(ib))
70       prob(1)=1.0d0
71       sumprob=1.0d0
72       do i=2,ngr
73         prob(i)=dexp(-(totfree_gr(i)-totfree_gr(1)))
74         sumprob=sumprob+prob(i)
75       enddo
76       do i=1,ngr
77         prob(i)=prob(i)/sumprob
78       enddo
79       sumprob=0.0d0
80       write (iout,'("clust   efree    prob sumprob")')
81       do i=1,ngr
82         sumprob=sumprob+prob(i)
83         write (iout,'(i5,f8.1,2f8.5)') i,totfree_gr(i)/beta_h(ib),
84      &    prob(i),sumprob
85       enddo
86       DO 81 IGR=1,NGR
87       LI=LICZ(IGR)
88       DO 82 I=1,LI 
89    82 IASS(NCONF(IGR,I))=IGR
90    81 CONTINUE
91       if (lgrp) then
92         do i=1,ncon
93           iass_tot(i,icut)=iass(i)
94 c          write (iout,*) icut,i,iass(i),iass_tot(i,icut)
95         enddo
96       endif
97       RETURN
98       END