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
38 double precision t1,t2,tcpu,difconf
40 double precision varia(maxvar)
41 double precision hrtime,mintime,sectime
45 call MPI_Init( IERROR )
46 call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
47 call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
50 write(iout,*) "SEVERE ERROR - Can't initialize MPI."
51 call mpi_finalize(ierror)
54 if (nprocs.gt.MaxProcs+1) then
55 write (2,*) "Error - too many processors",
57 write (2,*) "Increase MaxProcs and recompile"
58 call MPI_Finalize(IERROR)
68 c if (refstr) call read_ref_structure(*30)
76 print *,'MAIN: nnt=',nnt,' nct=',nct
82 IF (RCUTOFF(I).LT.0.0) THEN
83 RCUTOFF(I)=ABS(RCUTOFF(I))
89 write (iout,*) 'Number of cutoffs:',NCUT
90 write (iout,*) 'Cutoff values:'
92 WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT),
93 & printpdb(icut),printmol2(icut)
101 call read_coords(ncon,*20)
102 write (iout,*) 'from read_coords: ncon',ncon
104 write (iout,*) "nT",nT
106 write (iout,*) "iT",iT
108 call work_partition(.true.,ncon)
110 call probabl(iT,ncon_work,ncon,*20)
112 if (ncon_work.lt.2) then
113 write (iout,*) "Too few conformations; clustering skipped"
117 ndis=ncon_work*(ncon_work-1)/2
118 call work_partition(.true.,ndis)
124 WRITE (iout,'(A80)') TITEL
127 C CALCULATE DISTANCES
129 call daread_ccoords(1,ncon_work)
132 if (mod(i,100).eq.0) print *,'Calculating RMS i=',i
135 c(l,k)=allcart(l,k,i)
144 IND=IOFFSET(NCON_work,I,J)
146 if (ind.ge.indstart(me) .and. ind.le.indend(me)) then
149 DISS(IND1)=DIFCONF(I,J)
150 c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND)
157 WRITE (iout,'(/a,1pe14.5,a/)')
158 & 'Time for distance calculation:',T2-T1,' sec.'
160 PRINT '(a)','End of distance computation'
163 call MPI_Gatherv(diss(1),scount(me),MPI_REAL,diss(1),
164 & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
165 if (me.eq.master) then
167 scrachdir2d=scratchdir(:ilen(scratchdir))//'distance'
168 open(80,file=scrachdir2d,form='unformatted')
175 IND=IOFFSET(NCON,I,J)
176 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
177 & energy(j)-energy(i)
182 C Print out the RMS deviation matrix.
184 if (print_dist) CALL DISTOUT(NCON_work)
186 C call hierarchical clustering HC from F. Murtagh
190 write(iout,*) "-------------------------------------------"
191 write(iout,*) "HIERARCHICAL CLUSTERING using"
193 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
194 elseif (iopt.eq.2) then
195 write(iout,*) "SINGLE LINK METHOD"
196 elseif (iopt.eq.3) then
197 write(iout,*) "COMPLETE LINK METHOD"
198 elseif (iopt.eq.4) then
199 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
200 elseif (iopt.eq.5) then
201 write(iout,*) "MCQUITTY'S METHOD"
202 elseif (iopt.eq.6) then
203 write(iout,*) "MEDIAN (GOWER'S) METHOD"
204 elseif (iopt.eq.7) then
205 write(iout,*) "CENTROID METHOD"
207 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
208 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
212 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
213 write(iout,*) "February 1986"
214 write(iout,*) "References:"
215 write(iout,*) "1. Multidimensional clustering algorithms"
216 write(iout,*) " Fionn Murtagh"
217 write(iout,*) " Vienna : Physica-Verlag, 1985."
218 write(iout,*) "2. Multivariate data analysis"
219 write(iout,*) " Fionn Murtagh and Andre Heck"
220 write(iout,*) " Kluwer Academic Publishers, 1987"
221 write(iout,*) "-------------------------------------------"
225 write (iout,*) "The TOTFREE array"
227 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
235 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
237 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
239 write (iout,*) "Too few conformations to cluster."
242 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
243 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
252 licz(iclass(j,i))=licz(iclass(j,i))+1
253 nconf(iclass(j,i),licz(iclass(j,i)))=j
254 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
255 c & nconf(iclass(j,i),licz(iclass(j,i)))
261 IF (HEIGHT(L).EQ.IDUM) GOTO 190
264 write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
265 & " icut",icut," cutoff",rcutoff(icut)
266 IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
267 WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
268 write (iout,'(a,f8.2)') 'Maximum distance found:',
270 CALL SRTCLUST(ICUT,ncon_work,iT)
272 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
274 if (icut.gt.ncut) goto 191
281 licz(iclass(j,i))=licz(iclass(j,i))+1
282 nconf(iclass(j,i),licz(iclass(j,i)))=j
283 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
284 c & nconf(iclass(j,i),licz(iclass(j,i)))
285 cd print *,j,iclass(j,i),
286 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
297 WRITE (iout,'(/a,1pe14.5,a/)')
298 & 'Total time for clustering:',T2-T1,' sec.'
306 close(icbase,status="delete")
308 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
310 stop '********** Program terminated normally.'
311 20 write (iout,*) "Error reading coordinates"
313 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
316 30 write (iout,*) "Error reading reference structure"
318 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
322 c---------------------------------------------------------------------------
323 double precision function difconf(icon,jcon)
326 include 'sizesclu.dat'
327 include 'COMMON.CONTROL'
328 include 'COMMON.CLUSTER'
329 include 'COMMON.CHAIN'
330 include 'COMMON.INTERACT'
332 include 'COMMON.IOUNITS'
334 double precision przes(3),obrot(3,3)
335 double precision xx(3,maxres2),yy(3,maxres2)
336 integer i,ii,j,icon,jcon
343 xx(j,ii)=allcart(j,i,jcon)
348 c if (itype(i).ne.10) then
351 xx(j,ii)=allcart(j,i+nres,jcon)
352 yy(j,ii)=cref(j,i+nres)
356 call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv)
360 c(j,i)=allcart(j,i,jcon)
363 call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes,
367 print *,'error, rms^2 = ',rms,icon,jcon
370 if (non_conv) print *,non_conv,icon,jcon
374 C------------------------------------------------------------------------------
375 subroutine distout(ncon)
378 include 'sizesclu.dat'
381 include 'COMMON.IOUNITS'
382 include 'COMMON.CLUSTER'
383 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
386 write (iout,'(a)') 'The distance matrix'
388 nlim=min0(i+ncol-1,ncon)
389 write (iout,1000) (k,k=i,nlim)
390 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
391 1000 format (/8x,10(i4,3x))
392 1020 format (/1x,80(1h-)/)
403 IND=IOFFSET(NCON,j,k)
405 IND=IOFFSET(NCON,k,j)
408 write (iout,1010) j,(b(k),k=1,jlim-i+1)
411 1010 format (i5,3x,10(f6.2,1x))