source/cluster/wham/src/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