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=scratchdir(:ilen(scratchdir))//'/distance',
178 & form='unformatted')
185 IND=IOFFSET(NCON,I,J)
186 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
187 & energy(j)-energy(i)
192 C Print out the RMS deviation matrix.
194 if (print_dist) CALL DISTOUT(NCON_work)
196 C call hierarchical clustering HC from F. Murtagh
200 write(iout,*) "-------------------------------------------"
201 write(iout,*) "HIERARCHICAL CLUSTERING using"
203 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
204 elseif (iopt.eq.2) then
205 write(iout,*) "SINGLE LINK METHOD"
206 elseif (iopt.eq.3) then
207 write(iout,*) "COMPLETE LINK METHOD"
208 elseif (iopt.eq.4) then
209 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
210 elseif (iopt.eq.5) then
211 write(iout,*) "MCQUITTY'S METHOD"
212 elseif (iopt.eq.6) then
213 write(iout,*) "MEDIAN (GOWER'S) METHOD"
214 elseif (iopt.eq.7) then
215 write(iout,*) "CENTROID METHOD"
217 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
218 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
222 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
223 write(iout,*) "February 1986"
224 write(iout,*) "References:"
225 write(iout,*) "1. Multidimensional clustering algorithms"
226 write(iout,*) " Fionn Murtagh"
227 write(iout,*) " Vienna : Physica-Verlag, 1985."
228 write(iout,*) "2. Multivariate data analysis"
229 write(iout,*) " Fionn Murtagh and Andre Heck"
230 write(iout,*) " Kluwer Academic Publishers, 1987"
231 write(iout,*) "-------------------------------------------"
235 write (iout,*) "The TOTFREE array"
237 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
241 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
243 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
245 write (iout,*) "Too few conformations to cluster."
248 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
249 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
250 c 3/3/16 AL: added explicit number of cluters
251 if (nclust.gt.0) then
266 licz(iclass(j,i))=licz(iclass(j,i))+1
267 nconf(iclass(j,i),licz(iclass(j,i)))=j
268 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
269 c & nconf(iclass(j,i),licz(iclass(j,i)))
275 IF (HEIGHT(L).EQ.IDUM) GOTO 190
278 write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
279 & " icut",icut," cutoff",rcutoff(icut)
280 IF (nclust.gt.0.or.CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
282 & WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
283 write (iout,'(a,f8.2)') 'Maximum distance found:',
285 CALL SRTCLUST(ICUT,ncon_work,iT)
287 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
289 if (icut.gt.ncut) goto 191
296 licz(iclass(j,i))=licz(iclass(j,i))+1
297 nconf(iclass(j,i),licz(iclass(j,i)))=j
298 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
299 c & nconf(iclass(j,i),licz(iclass(j,i)))
300 cd print *,j,iclass(j,i),
301 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
312 WRITE (iout,'(/a,1pe14.5,a/)')
313 & 'Total time for clustering:',T2-T1,' sec.'
321 close(icbase,status="delete")
323 call MPI_Finalize(IERROR)
325 stop '********** Program terminated normally.'
326 20 write (iout,*) "Error reading coordinates"
328 call MPI_Finalize(IERROR)
331 30 write (iout,*) "Error reading reference structure"
333 call MPI_Finalize(IERROR)
337 c---------------------------------------------------------------------------
338 double precision function difconf(icon,jcon)
341 include 'sizesclu.dat'
342 include 'COMMON.CONTROL'
343 include 'COMMON.CLUSTER'
344 include 'COMMON.CHAIN'
345 include 'COMMON.INTERACT'
347 include 'COMMON.IOUNITS'
349 double precision przes(3),obrot(3,3)
350 double precision rmscalc
351 integer icon,jcon,k,l
352 c write (iout,*) "DIFCONF: ICON",icon," JCON",jcon
355 cref(l,k)=allcart(l,k,icon)
356 c(l,k)=allcart(l,k,jcon)
359 difconf=rmscalc(c(1,1),cref(1,1),przes,obrot,ipermmin)
362 C------------------------------------------------------------------------------
363 subroutine distout(ncon)
366 include 'sizesclu.dat'
369 include 'COMMON.IOUNITS'
370 include 'COMMON.CLUSTER'
371 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
374 write (iout,'(a)') 'The distance matrix'
376 nlim=min0(i+ncol-1,ncon)
377 write (iout,1000) (k,k=i,nlim)
378 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
379 1000 format (/8x,10(i4,3x))
380 1020 format (/1x,80(1h-)/)
391 IND=IOFFSET(NCON,j,k)
393 IND=IOFFSET(NCON,k,j)
396 write (iout,1010) j,(b(k),k=1,jlim-i+1)
399 1010 format (i5,3x,10(f6.2,1x))