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
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
83 IF (RCUTOFF(I).LT.0.0) THEN
84 RCUTOFF(I)=ABS(RCUTOFF(I))
90 write (iout,*) 'Number of cutoffs:',NCUT
91 write (iout,*) 'Cutoff values:'
93 WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT),
94 & printpdb(icut),printmol2(icut)
102 call read_coords(ncon,*20)
103 write (iout,*) 'from read_coords: ncon',ncon
105 write (iout,*) "nT",nT
107 write (iout,*) "iT",iT
109 call work_partition(.true.,ncon)
111 call probabl(iT,ncon_work,ncon,*20)
113 if (ncon_work.lt.2) then
114 write (iout,*) "Too few conformations; clustering skipped"
118 ndis=ncon_work*(ncon_work-1)/2
119 call work_partition(.true.,ndis)
125 WRITE (iout,'(A80)') TITEL
128 C CALCULATE DISTANCES
130 call daread_ccoords(1,ncon_work)
133 if (mod(i,100).eq.0) print *,'Calculating RMS i=',i
136 c(l,k)=allcart(l,k,i)
145 IND=IOFFSET(NCON_work,I,J)
147 if (ind.ge.indstart(me) .and. ind.le.indend(me)) then
151 DISS_(IND1)=DIFCONF(I,J)
153 DISS(IND1)=DIFCONF(I,J)
155 c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND)
162 WRITE (iout,'(/a,1pe14.5,a/)')
163 & 'Time for distance calculation:',T2-T1,' sec.'
165 PRINT '(a)','End of distance computation'
168 call MPI_Gatherv(diss_(1),scount(me),MPI_REAL,diss(1),
169 & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR)
170 if (me.eq.master) then
172 scrachdir2d=scratchdir(:ilen(scratchdir))//'distance'
173 open(80,file=scrachdir2d,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
344 xx(j,ii)=allcart(j,i,jcon)
349 c if (itype(i).ne.10) then
352 xx(j,ii)=allcart(j,i+nres,jcon)
353 yy(j,ii)=cref(j,i+nres)
357 call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv)
361 c(j,i)=allcart(j,i,jcon)
364 call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes,
368 print *,'error, rms^2 = ',rms,icon,jcon
371 if (non_conv) print *,non_conv,icon,jcon
375 C------------------------------------------------------------------------------
376 subroutine distout(ncon)
379 include 'sizesclu.dat'
382 include 'COMMON.IOUNITS'
383 include 'COMMON.CLUSTER'
384 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
387 write (iout,'(a)') 'The distance matrix'
389 nlim=min0(i+ncol-1,ncon)
390 write (iout,1000) (k,k=i,nlim)
391 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
392 1000 format (/8x,10(i4,3x))
393 1020 format (/1x,80(1h-)/)
404 IND=IOFFSET(NCON,j,k)
406 IND=IOFFSET(NCON,k,j)
409 write (iout,1010) j,(b(k),k=1,jlim-i+1)
412 1010 format (i5,3x,10(f6.2,1x))