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
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)
67 c if (refstr) call read_ref_structure(*30)
74 c write (iout,*) "Before permut"
75 c write (iout,*) "symetr", symetr
78 c write (iout,*) "after permut"
80 print *,'MAIN: nnt=',nnt,' nct=',nct
86 IF (RCUTOFF(I).LT.0.0) THEN
87 RCUTOFF(I)=ABS(RCUTOFF(I))
93 write (iout,*) 'Number of cutoffs:',NCUT
94 write (iout,*) 'Cutoff values:'
96 WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT),
97 & printpdb(icut),printmol2(icut)
105 call read_coords(ncon,*20)
106 write (iout,*) 'from read_coords: ncon',ncon
108 write (iout,*) "nT",nT
110 write (iout,*) "iT",iT
112 call work_partition(.true.,ncon)
115 call probabl(iT,ncon_work,ncon,*20)
117 if (ncon_work.lt.2) then
118 write (iout,*) "Too few conformations; clustering skipped"
122 ndis=ncon_work*(ncon_work-1)/2
123 call work_partition(.true.,ndis)
129 WRITE (iout,'(A80)') TITEL
132 C CALCULATE DISTANCES
134 call daread_ccoords(1,ncon_work)
137 if (mod(i,100).eq.0) print *,'Calculating RMS i=',i
140 c(l,k)=allcart(l,k,i)
150 IND=IOFFSET(NCON_work,I,J)
152 if (ind.ge.indstart(me) .and. ind.le.indend(me)) then
155 DISS(IND1)=DIFCONF(I,J)
156 c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND)
163 WRITE (iout,'(/a,1pe14.5,a/)')
164 & 'Time for distance calculation:',T2-T1,' sec.'
166 PRINT '(a)','End of distance computation'
168 scount_buf=scount(me)
171 diss_buf(ijk)=diss(ijk)
176 WRITE (iout,*) "Wchodze do call MPI_Gatherv"
177 call MPI_Gatherv(diss_buf(1),scount_buf,MPI_REAL,diss(1),
178 & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
179 if (me.eq.master) then
181 open(80,file='/tmp/distance',form='unformatted')
188 IND=IOFFSET(NCON,I,J)
189 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
190 & energy(j)-energy(i)
195 C Print out the RMS deviation matrix.
197 if (print_dist) CALL DISTOUT(NCON_work)
199 C call hierarchical clustering HC from F. Murtagh
203 write(iout,*) "-------------------------------------------"
204 write(iout,*) "HIERARCHICAL CLUSTERING using"
206 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
207 elseif (iopt.eq.2) then
208 write(iout,*) "SINGLE LINK METHOD"
209 elseif (iopt.eq.3) then
210 write(iout,*) "COMPLETE LINK METHOD"
211 elseif (iopt.eq.4) then
212 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
213 elseif (iopt.eq.5) then
214 write(iout,*) "MCQUITTY'S METHOD"
215 elseif (iopt.eq.6) then
216 write(iout,*) "MEDIAN (GOWER'S) METHOD"
217 elseif (iopt.eq.7) then
218 write(iout,*) "CENTROID METHOD"
220 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
221 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
225 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
226 write(iout,*) "February 1986"
227 write(iout,*) "References:"
228 write(iout,*) "1. Multidimensional clustering algorithms"
229 write(iout,*) " Fionn Murtagh"
230 write(iout,*) " Vienna : Physica-Verlag, 1985."
231 write(iout,*) "2. Multivariate data analysis"
232 write(iout,*) " Fionn Murtagh and Andre Heck"
233 write(iout,*) " Kluwer Academic Publishers, 1987"
234 write(iout,*) "-------------------------------------------"
238 write (iout,*) "The TOTFREE array"
240 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
244 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
246 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
248 write (iout,*) "Too few conformations to cluster."
251 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
252 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
261 licz(iclass(j,i))=licz(iclass(j,i))+1
262 nconf(iclass(j,i),licz(iclass(j,i)))=j
263 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
264 c & nconf(iclass(j,i),licz(iclass(j,i)))
270 IF (HEIGHT(L).EQ.IDUM) GOTO 190
273 write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
274 & " icut",icut," cutoff",rcutoff(icut)
275 IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
276 WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
277 write (iout,'(a,f8.2)') 'Maximum distance found:',
279 CALL SRTCLUST(ICUT,ncon_work,iT)
281 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
283 if (icut.gt.ncut) goto 191
290 licz(iclass(j,i))=licz(iclass(j,i))+1
291 nconf(iclass(j,i),licz(iclass(j,i)))=j
292 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
293 c & nconf(iclass(j,i),licz(iclass(j,i)))
294 cd print *,j,iclass(j,i),
295 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
306 WRITE (iout,'(/a,1pe14.5,a/)')
307 & 'Total time for clustering:',T2-T1,' sec.'
315 close(icbase,status="delete")
317 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
319 stop '********** Program terminated normally.'
320 20 write (iout,*) "Error reading coordinates"
322 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
325 30 write (iout,*) "Error reading reference structure"
327 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
331 c---------------------------------------------------------------------------
332 double precision function difconf(icon,jcon)
335 include 'sizesclu.dat'
336 include 'COMMON.CONTROL'
337 include 'COMMON.CLUSTER'
338 include 'COMMON.CHAIN'
339 include 'COMMON.INTERACT'
341 include 'COMMON.IOUNITS'
343 double precision przes(3),obrot(3,3)
344 double precision xx(3,maxres2),yy(3,maxres2)
345 integer i,ii,j,icon,jcon,kkk,nperm,chalen,zzz
346 integer iaperm,ibezperm,run
347 double precision rms,rmsmina
348 c write (iout,*) "tu dochodze"
354 c write (iout,*) "nperm",nperm
356 c write (iout,*) "tabperm", tabperm(1,1)
360 chalen=int((nend-nstart+2)/symetr)
362 do i=nstart,(nstart+chalen-1)
364 c write (iout,*) "tutaj",zzz
366 iaperm=(zzz-1)*chalen+i
367 ibezperm=(run-1)*chalen+i
369 xx(j,ii)=allcart(j,iaperm,jcon)
370 yy(j,ii)=cref(j,ibezperm,kkk)
375 do i=nstart,(nstart+chalen-1)
378 iaperm=(zzz-1)*chalen+i
379 ibezperm=(run-1)*chalen+i
380 c if (itype(i).ne.10) then
383 xx(j,ii)=allcart(j,iaperm+nres,jcon)
384 yy(j,ii)=cref(j,ibezperm+nres,kkk)
389 call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv)
391 chalen=int((nct-nnt+2)/symetr)
393 do i=nnt,(nnt+chalen-1)
395 c write (iout,*) "tu szukaj", zzz,run,kkk
396 iaperm=(zzz-1)*chalen+i
397 ibezperm=(run-1)*chalen+i
400 c(j,i)=allcart(j,iaperm,jcon)
404 call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1,
409 print *,'error, rms^2 = ',rms,icon,jcon
412 if (non_conv) print *,non_conv,icon,jcon
413 if (rmsmina.gt.rms) rmsmina=rms
415 difconf=dsqrt(rmsmina)
418 C------------------------------------------------------------------------------
419 subroutine distout(ncon)
422 include 'sizesclu.dat'
425 include 'COMMON.IOUNITS'
426 include 'COMMON.CLUSTER'
427 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
430 write (iout,'(a)') 'The distance matrix'
432 nlim=min0(i+ncol-1,ncon)
433 write (iout,1000) (k,k=i,nlim)
434 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
435 1000 format (/8x,10(i4,3x))
436 1020 format (/1x,80(1h-)/)
447 IND=IOFFSET(NCON,j,k)
449 IND=IOFFSET(NCON,k,j)
452 write (iout,1010) j,(b(k),k=1,jlim-i+1)
455 1010 format (i5,3x,10(f6.2,1x))