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)
26 character*240 lineh,scrachdir2d
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)
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,ilen,is,ie
38 double precision t1,t2,tcpu,difconf
41 double precision varia(maxvar)
42 double precision hrtime,mintime,sectime
46 call MPI_Init( IERROR )
47 call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
48 call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
51 write(iout,*) "SEVERE ERROR - Can't initialize MPI."
52 call mpi_finalize(ierror)
55 if (nprocs.gt.MaxProcs+1) then
56 write (2,*) "Error - too many processors",
58 write (2,*) "Increase MaxProcs and recompile"
59 call MPI_Finalize(IERROR)
69 c if (refstr) call read_ref_structure(*30)
77 print *,'MAIN: nnt=',nnt,' nct=',nct
89 IF (RCUTOFF(I).LT.0.0) THEN
90 RCUTOFF(I)=ABS(RCUTOFF(I))
98 write (iout,*) 'Number of cutoffs:',NCUT
99 write (iout,*) 'Cutoff values:'
101 WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT),
102 & printpdb(icut),printmol2(icut)
104 else if (nclust.gt.0) then
105 write (iout,'("Number of clusters requested",i5)') nclust
108 & write (iout,*) "ERROR: Either nclust or ncut must be >0"
117 call read_coords(ncon,*20)
118 write (iout,*) 'from read_coords: ncon',ncon
120 write (iout,*) "nT",nT
122 write (iout,*) "iT",iT
124 call work_partition(.true.,ncon)
126 call probabl(iT,ncon_work,ncon,*20)
128 if (ncon_work.lt.2) then
129 write (iout,*) "Too few conformations; clustering skipped"
133 ndis=ncon_work*(ncon_work-1)/2
134 call work_partition(.true.,ndis)
140 WRITE (iout,'(A80)') TITEL
143 C CALCULATE DISTANCES
145 call daread_ccoords(1,ncon_work)
148 if (mod(i,100).eq.0) print *,'Calculating RMS i=',i
151 c(l,k)=allcart(l,k,i)
160 IND=IOFFSET(NCON_work,I,J)
162 if (ind.ge.indstart(me) .and. ind.le.indend(me)) then
166 DISS_(IND1)=DIFCONF(I,J)
168 DISS(IND1)=DIFCONF(I,J)
170 c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND)
177 WRITE (iout,'(/a,1pe14.5,a/)')
178 & 'Time for distance calculation:',T2-T1,' sec.'
180 PRINT '(a)','End of distance computation'
183 call MPI_Gatherv(diss_(1),scount(me),MPI_REAL,diss(1),
184 & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
185 if (me.eq.master) then
187 scrachdir2d=scratchdir(:ilen(scratchdir))//'distance'
188 open(80,file=scrachdir2d,form='unformatted')
195 IND=IOFFSET(NCON,I,J)
196 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
197 & energy(j)-energy(i)
202 C Print out the RMS deviation matrix.
204 if (print_dist) CALL DISTOUT(NCON_work)
206 C call hierarchical clustering HC from F. Murtagh
210 write(iout,*) "-------------------------------------------"
211 write(iout,*) "HIERARCHICAL CLUSTERING using"
213 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
214 elseif (iopt.eq.2) then
215 write(iout,*) "SINGLE LINK METHOD"
216 elseif (iopt.eq.3) then
217 write(iout,*) "COMPLETE LINK METHOD"
218 elseif (iopt.eq.4) then
219 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
220 elseif (iopt.eq.5) then
221 write(iout,*) "MCQUITTY'S METHOD"
222 elseif (iopt.eq.6) then
223 write(iout,*) "MEDIAN (GOWER'S) METHOD"
224 elseif (iopt.eq.7) then
225 write(iout,*) "CENTROID METHOD"
227 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
228 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
232 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
233 write(iout,*) "February 1986"
234 write(iout,*) "References:"
235 write(iout,*) "1. Multidimensional clustering algorithms"
236 write(iout,*) " Fionn Murtagh"
237 write(iout,*) " Vienna : Physica-Verlag, 1985."
238 write(iout,*) "2. Multivariate data analysis"
239 write(iout,*) " Fionn Murtagh and Andre Heck"
240 write(iout,*) " Kluwer Academic Publishers, 1987"
241 write(iout,*) "-------------------------------------------"
245 write (iout,*) "The TOTFREE array"
247 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
251 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
253 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
255 write (iout,*) "Too few conformations to cluster."
258 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
259 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
261 c 3/3/16 AL: added explicit number of cluters
262 if (nclust.gt.0) then
277 licz(iclass(j,i))=licz(iclass(j,i))+1
278 nconf(iclass(j,i),licz(iclass(j,i)))=j
279 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
280 c & nconf(iclass(j,i),licz(iclass(j,i)))
286 IF (HEIGHT(L).EQ.IDUM) GOTO 190
289 c write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
290 c & " icut",icut," cutoff",rcutoff(icut)
291 IF (nclust.gt.0.or.CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
293 & WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
294 write (iout,'(a,f8.2)') 'Maximum distance found:',
296 CALL SRTCLUST(ICUT,ncon_work,iT)
298 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
300 if (icut.gt.ncut) goto 191
308 licz(iclass(j,ii))=licz(iclass(j,ii))+1
309 nconf(iclass(j,ii),licz(iclass(j,ii)))=j
310 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
311 c & nconf(iclass(j,i),licz(iclass(j,i)))
312 cd print *,j,iclass(j,i),
313 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
324 WRITE (iout,'(/a,1pe14.5,a/)')
325 & 'Total time for clustering:',T2-T1,' sec.'
333 close(icbase,status="delete")
335 call MPI_Finalize(IERROR)
337 stop '********** Program terminated normally.'
338 20 write (iout,*) "Error reading coordinates"
340 call MPI_Finalize(IERROR)
343 30 write (iout,*) "Error reading reference structure"
345 call MPI_Finalize(IERROR)
349 c---------------------------------------------------------------------------
350 double precision function difconf(icon,jcon)
353 include 'sizesclu.dat'
354 include 'COMMON.CONTROL'
355 include 'COMMON.CLUSTER'
356 include 'COMMON.CHAIN'
357 include 'COMMON.INTERACT'
359 include 'COMMON.IOUNITS'
361 double precision przes(3),obrot(3,3)
362 double precision xx(3,maxres2),yy(3,maxres2)
363 integer i,ii,j,icon,jcon
370 xx(j,ii)=allcart(j,i,jcon)
375 c if (itype(i).ne.10) then
378 xx(j,ii)=allcart(j,i+nres,jcon)
379 yy(j,ii)=cref(j,i+nres)
383 call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv)
387 c(j,i)=allcart(j,i,jcon)
390 call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes,
394 print *,'error, rms^2 = ',rms,icon,jcon
397 if (non_conv) print *,non_conv,icon,jcon
401 C------------------------------------------------------------------------------
402 subroutine distout(ncon)
405 include 'sizesclu.dat'
408 include 'COMMON.IOUNITS'
409 include 'COMMON.CLUSTER'
410 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
413 write (iout,'(a)') 'The distance matrix'
415 nlim=min0(i+ncol-1,ncon)
416 write (iout,1000) (k,k=i,nlim)
417 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
418 1000 format (/8x,10(i4,3x))
419 1020 format (/1x,80(1h-)/)
430 IND=IOFFSET(NCON,j,k)
432 IND=IOFFSET(NCON,k,j)
435 write (iout,1010) j,(b(k),k=1,jlim-i+1)
438 1010 format (i5,3x,10(f6.2,1x))