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)
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
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'
169 call MPI_Gatherv(diss(1),scount(me),MPI_REAL,diss(1),
170 & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
171 if (me.eq.master) then
173 open(80,file='/tmp/distance',form='unformatted')
180 IND=IOFFSET(NCON,I,J)
181 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
182 & energy(j)-energy(i)
187 C Print out the RMS deviation matrix.
189 if (print_dist) CALL DISTOUT(NCON_work)
191 C call hierarchical clustering HC from F. Murtagh
195 write(iout,*) "-------------------------------------------"
196 write(iout,*) "HIERARCHICAL CLUSTERING using"
198 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
199 elseif (iopt.eq.2) then
200 write(iout,*) "SINGLE LINK METHOD"
201 elseif (iopt.eq.3) then
202 write(iout,*) "COMPLETE LINK METHOD"
203 elseif (iopt.eq.4) then
204 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
205 elseif (iopt.eq.5) then
206 write(iout,*) "MCQUITTY'S METHOD"
207 elseif (iopt.eq.6) then
208 write(iout,*) "MEDIAN (GOWER'S) METHOD"
209 elseif (iopt.eq.7) then
210 write(iout,*) "CENTROID METHOD"
212 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
213 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
217 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
218 write(iout,*) "February 1986"
219 write(iout,*) "References:"
220 write(iout,*) "1. Multidimensional clustering algorithms"
221 write(iout,*) " Fionn Murtagh"
222 write(iout,*) " Vienna : Physica-Verlag, 1985."
223 write(iout,*) "2. Multivariate data analysis"
224 write(iout,*) " Fionn Murtagh and Andre Heck"
225 write(iout,*) " Kluwer Academic Publishers, 1987"
226 write(iout,*) "-------------------------------------------"
230 write (iout,*) "The TOTFREE array"
232 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
236 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
238 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
240 write (iout,*) "Too few conformations to cluster."
243 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
244 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
253 licz(iclass(j,i))=licz(iclass(j,i))+1
254 nconf(iclass(j,i),licz(iclass(j,i)))=j
255 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
256 c & nconf(iclass(j,i),licz(iclass(j,i)))
262 IF (HEIGHT(L).EQ.IDUM) GOTO 190
265 write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
266 & " icut",icut," cutoff",rcutoff(icut)
267 IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
268 WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
269 write (iout,'(a,f8.2)') 'Maximum distance found:',
271 CALL SRTCLUST(ICUT,ncon_work,iT)
273 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
275 if (icut.gt.ncut) goto 191
282 licz(iclass(j,i))=licz(iclass(j,i))+1
283 nconf(iclass(j,i),licz(iclass(j,i)))=j
284 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
285 c & nconf(iclass(j,i),licz(iclass(j,i)))
286 cd print *,j,iclass(j,i),
287 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
298 WRITE (iout,'(/a,1pe14.5,a/)')
299 & 'Total time for clustering:',T2-T1,' sec.'
307 close(icbase,status="delete")
309 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
311 stop '********** Program terminated normally.'
312 20 write (iout,*) "Error reading coordinates"
314 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
317 30 write (iout,*) "Error reading reference structure"
319 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
323 c---------------------------------------------------------------------------
324 double precision function difconf(icon,jcon)
327 include 'sizesclu.dat'
328 include 'COMMON.CONTROL'
329 include 'COMMON.CLUSTER'
330 include 'COMMON.CHAIN'
331 include 'COMMON.INTERACT'
333 include 'COMMON.IOUNITS'
335 double precision przes(3),obrot(3,3)
336 double precision xx(3,maxres2),yy(3,maxres2)
337 integer i,ii,j,icon,jcon,kkk,nperm,chalen,zzz
338 integer iaperm,ibezperm,run
339 double precision rms,rmsmina
340 c write (iout,*) "tu dochodze"
346 c write (iout,*) "nperm",nperm
348 c write (iout,*) "tabperm", tabperm(1,1)
352 chalen=int((nend-nstart+2)/symetr)
354 do i=nstart,(nstart+chalen-1)
356 c write (iout,*) "tutaj",zzz
358 iaperm=(zzz-1)*chalen+i
359 ibezperm=(run-1)*chalen+i
361 xx(j,ii)=allcart(j,iaperm,jcon)
362 yy(j,ii)=cref(j,ibezperm,kkk)
367 do i=nstart,(nstart+chalen-1)
370 iaperm=(zzz-1)*chalen+i
371 ibezperm=(run-1)*chalen+i
372 c if (itype(i).ne.10) then
375 xx(j,ii)=allcart(j,iaperm+nres,jcon)
376 yy(j,ii)=cref(j,ibezperm+nres,kkk)
381 call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv)
383 chalen=int((nct-nnt+2)/symetr)
385 do i=nnt,(nnt+chalen-1)
387 c write (iout,*) "tu szukaj", zzz,run,kkk
388 iaperm=(zzz-1)*chalen+i
389 ibezperm=(run-1)*chalen+i
392 c(j,i)=allcart(j,iaperm,jcon)
396 call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1,
401 print *,'error, rms^2 = ',rms,icon,jcon
404 if (non_conv) print *,non_conv,icon,jcon
405 if (rmsmina.gt.rms) rmsmina=rms
407 difconf=dsqrt(rmsmina)
410 C------------------------------------------------------------------------------
411 subroutine distout(ncon)
414 include 'sizesclu.dat'
417 include 'COMMON.IOUNITS'
418 include 'COMMON.CLUSTER'
419 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
422 write (iout,'(a)') 'The distance matrix'
424 nlim=min0(i+ncol-1,ncon)
425 write (iout,1000) (k,k=i,nlim)
426 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
427 1000 format (/8x,10(i4,3x))
428 1020 format (/1x,80(1h-)/)
439 IND=IOFFSET(NCON,j,k)
441 IND=IOFFSET(NCON,k,j)
444 write (iout,1010) j,(b(k),k=1,jlim-i+1)
447 1010 format (i5,3x,10(f6.2,1x))