2 C Program to cluster united-residue MCM results.
9 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
12 include 'COMMON.TIME1'
13 include 'COMMON.INTERACT'
14 include 'COMMON.NAMES'
16 include 'COMMON.HEADER'
17 include 'COMMON.CONTROL'
18 include 'COMMON.CHAIN'
20 include 'COMMON.CLUSTER'
21 include 'COMMON.IOUNITS'
23 logical printang(max_cut)
24 integer printpdb(max_cut)
25 integer printmol2(max_cut)
27 REAL CRIT(maxconf),MEMBR(maxconf)
28 REAL CRITVAL(maxconf-1)
29 INTEGER IA(maxconf),IB(maxconf)
30 INTEGER ICLASS(maxconf,maxconf-1),HVALS(maxconf-1)
31 INTEGER IORDER(maxconf-1),HEIGHT(maxconf-1)
32 integer nn,ndis,scount_buf
33 real*4 DISNN, diss_buf(maxdist)
34 DIMENSION NN(maxconf),DISNN(maxconf)
36 integer i,j,k,l,m,n,len,lev,idum,ii,ind,ioffset,jj,icut,ncon,
37 & it,ncon_work,ind1,kkk, ijk, is,ie
38 double precision t1,t2,tcpu,difconf
40 double precision varia(maxvar)
41 double precision hrtime,mintime,sectime
44 call MPI_Init( IERROR )
45 call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
46 call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
49 write(iout,*) "SEVERE ERROR - Can't initialize MPI."
50 call mpi_finalize(ierror)
53 if (nprocs.gt.MaxProcs+1) then
54 write (2,*) "Error - too many processors",
56 write (2,*) "Increase MaxProcs and recompile"
57 call MPI_Finalize(IERROR)
68 c write (iout,*) "Main: refstr ",refstr
69 if (refstr) call read_ref_structure(*30)
86 IF (RCUTOFF(I).LT.0.0) THEN
87 RCUTOFF(I)=ABS(RCUTOFF(I))
95 write (iout,*) 'Number of cutoffs:',NCUT
96 write (iout,*) 'Cutoff values:'
98 WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT),
99 & printpdb(icut),printmol2(icut)
101 else if (nclust.gt.0) then
102 write (iout,'("Number of clusters requested",i5)') nclust
105 & write (iout,*) "ERROR: Either nclust or ncut must be >0"
114 call read_coords(ncon,*20)
115 write (iout,*) 'from read_coords: ncon',ncon
117 write (iout,*) "nT",nT
119 write (iout,*) "Temperature",1.0d0/(beta_h(iT)*1.987D-3)
121 call work_partition(.true.,ncon)
123 call probabl(iT,ncon_work,ncon,*20)
125 if (ncon_work.lt.2) then
126 write (iout,*) "Too few conformations; clustering skipped"
130 ndis=ncon_work*(ncon_work-1)/2
131 call work_partition(.true.,ndis)
136 WRITE (iout,'(A80)') TITEL
139 C CALCULATE DISTANCES
141 call daread_ccoords(1,ncon_work)
144 c if (mod(i,100).eq.0) print *,'Calculating RMS i=',i
146 IND=IOFFSET(NCON_work,I,J)
148 if (ind.ge.indstart(me) .and. ind.le.indend(me)) then
151 DISS(IND1)=DIFCONF(I,J)
152 c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND)
159 WRITE (iout,'(/a,1pe14.5,a/)')
160 & 'Time for distance calculation:',T2-T1,' sec.'
162 c PRINT '(a)','End of distance computation'
164 scount_buf=scount(me)
167 diss_buf(ijk)=diss(ijk)
172 WRITE (iout,*) "Wchodze do call MPI_Gatherv"
173 call MPI_Gatherv(diss_buf(1),scount_buf,MPI_REAL,diss(1),
174 & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
175 if (me.eq.master) then
177 open(80,file='/tmp/distance',form='unformatted')
184 IND=IOFFSET(NCON,I,J)
185 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
186 & energy(j)-energy(i)
191 C Print out the RMS deviation matrix.
193 if (print_dist) CALL DISTOUT(NCON_work)
195 C call hierarchical clustering HC from F. Murtagh
199 write(iout,*) "-------------------------------------------"
200 write(iout,*) "HIERARCHICAL CLUSTERING using"
202 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
203 elseif (iopt.eq.2) then
204 write(iout,*) "SINGLE LINK METHOD"
205 elseif (iopt.eq.3) then
206 write(iout,*) "COMPLETE LINK METHOD"
207 elseif (iopt.eq.4) then
208 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
209 elseif (iopt.eq.5) then
210 write(iout,*) "MCQUITTY'S METHOD"
211 elseif (iopt.eq.6) then
212 write(iout,*) "MEDIAN (GOWER'S) METHOD"
213 elseif (iopt.eq.7) then
214 write(iout,*) "CENTROID METHOD"
216 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
217 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
221 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
222 write(iout,*) "February 1986"
223 write(iout,*) "References:"
224 write(iout,*) "1. Multidimensional clustering algorithms"
225 write(iout,*) " Fionn Murtagh"
226 write(iout,*) " Vienna : Physica-Verlag, 1985."
227 write(iout,*) "2. Multivariate data analysis"
228 write(iout,*) " Fionn Murtagh and Andre Heck"
229 write(iout,*) " Kluwer Academic Publishers, 1987"
230 write(iout,*) "-------------------------------------------"
234 write (iout,*) "The TOTFREE array"
236 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
240 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
242 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
244 write (iout,*) "Too few conformations to cluster."
247 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
248 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
249 c 3/3/16 AL: added explicit number of cluters
250 if (nclust.gt.0) then
265 licz(iclass(j,i))=licz(iclass(j,i))+1
266 nconf(iclass(j,i),licz(iclass(j,i)))=j
267 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
268 c & nconf(iclass(j,i),licz(iclass(j,i)))
274 IF (HEIGHT(L).EQ.IDUM) GOTO 190
277 write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
278 & " icut",icut," cutoff",rcutoff(icut)
279 IF (nclust.gt.0.or.CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
281 & WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
282 write (iout,'(a,f8.2)') 'Maximum distance found:',
284 CALL SRTCLUST(ICUT,ncon_work,iT)
286 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
288 if (icut.gt.ncut) goto 191
295 licz(iclass(j,i))=licz(iclass(j,i))+1
296 nconf(iclass(j,i),licz(iclass(j,i)))=j
297 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
298 c & nconf(iclass(j,i),licz(iclass(j,i)))
299 cd print *,j,iclass(j,i),
300 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
311 WRITE (iout,'(/a,1pe14.5,a/)')
312 & 'Total time for clustering:',T2-T1,' sec.'
320 close(icbase,status="delete")
322 call MPI_Finalize(IERROR)
324 stop '********** Program terminated normally.'
325 20 write (iout,*) "Error reading coordinates"
327 call MPI_Finalize(IERROR)
330 30 write (iout,*) "Error reading reference structure"
332 call MPI_Finalize(IERROR)
336 c---------------------------------------------------------------------------
337 double precision function difconf(icon,jcon)
340 include 'sizesclu.dat'
341 include 'COMMON.CONTROL'
342 include 'COMMON.CLUSTER'
343 include 'COMMON.CHAIN'
344 include 'COMMON.INTERACT'
346 include 'COMMON.IOUNITS'
348 double precision przes(3),obrot(3,3)
349 double precision rmscalc
350 integer icon,jcon,k,l
351 c write (iout,*) "DIFCONF: ICON",icon," JCON",jcon
354 cref(l,k)=allcart(l,k,icon)
355 c(l,k)=allcart(l,k,jcon)
358 difconf=rmscalc(c(1,1),cref(1,1),przes,obrot,ipermmin)
361 C------------------------------------------------------------------------------
362 subroutine distout(ncon)
365 include 'sizesclu.dat'
368 include 'COMMON.IOUNITS'
369 include 'COMMON.CLUSTER'
370 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
373 write (iout,'(a)') 'The distance matrix'
375 nlim=min0(i+ncol-1,ncon)
376 write (iout,1000) (k,k=i,nlim)
377 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
378 1000 format (/8x,10(i4,3x))
379 1020 format (/1x,80(1h-)/)
390 IND=IOFFSET(NCON,j,k)
392 IND=IOFFSET(NCON,k,j)
395 write (iout,1010) j,(b(k),k=1,jlim-i+1)
398 1010 format (i5,3x,10(f6.2,1x))