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,
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 open(80,file='/tmp/distance',form='unformatted')
174 IND=IOFFSET(NCON,I,J)
175 write (jrms,'(2i5,2f10.5)') i,j,diss(IND),
176 & energy(j)-energy(i)
181 C Print out the RMS deviation matrix.
183 if (print_dist) CALL DISTOUT(NCON_work)
185 C call hierarchical clustering HC from F. Murtagh
189 write(iout,*) "-------------------------------------------"
190 write(iout,*) "HIERARCHICAL CLUSTERING using"
192 write(iout,*) "WARD'S MINIMUM VARIANCE METHOD"
193 elseif (iopt.eq.2) then
194 write(iout,*) "SINGLE LINK METHOD"
195 elseif (iopt.eq.3) then
196 write(iout,*) "COMPLETE LINK METHOD"
197 elseif (iopt.eq.4) then
198 write(iout,*) "AVERAGE LINK (OR GROUP AVERAGE) METHOD"
199 elseif (iopt.eq.5) then
200 write(iout,*) "MCQUITTY'S METHOD"
201 elseif (iopt.eq.6) then
202 write(iout,*) "MEDIAN (GOWER'S) METHOD"
203 elseif (iopt.eq.7) then
204 write(iout,*) "CENTROID METHOD"
206 write(iout,*) "IOPT=",iopt," IS INVALID, use 1-7"
207 write(*,*) "IOPT=",iopt," IS INVALID, use 1-7"
211 write(iout,*) "hc.f by F. Murtagh, ESA/ESO/STECF, Garching"
212 write(iout,*) "February 1986"
213 write(iout,*) "References:"
214 write(iout,*) "1. Multidimensional clustering algorithms"
215 write(iout,*) " Fionn Murtagh"
216 write(iout,*) " Vienna : Physica-Verlag, 1985."
217 write(iout,*) "2. Multivariate data analysis"
218 write(iout,*) " Fionn Murtagh and Andre Heck"
219 write(iout,*) " Kluwer Academic Publishers, 1987"
220 write(iout,*) "-------------------------------------------"
224 write (iout,*) "The TOTFREE array"
226 write (iout,'(2i5,f10.5)') i,list_conf(i),totfree(i)
230 CALL HC(N,M,LEN,IOPT,IA,IB,CRIT,MEMBR,NN,DISNN,FLAG,DISS)
232 write (iout,*) "n",n," ncon_work",ncon_work," lev",lev
234 write (iout,*) "Too few conformations to cluster."
237 CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT)
238 c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL)
247 licz(iclass(j,i))=licz(iclass(j,i))+1
248 nconf(iclass(j,i),licz(iclass(j,i)))=j
249 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
250 c & nconf(iclass(j,i),licz(iclass(j,i)))
256 IF (HEIGHT(L).EQ.IDUM) GOTO 190
259 write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM),
260 & " icut",icut," cutoff",rcutoff(icut)
261 IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN
262 WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut)
263 write (iout,'(a,f8.2)') 'Maximum distance found:',
265 CALL SRTCLUST(ICUT,ncon_work,iT)
267 CALL WRTCLUST(ncon_work,ICUT,PRINTANG,PRINTPDB,PRINTMOL2,iT)
269 if (icut.gt.ncut) goto 191
276 licz(iclass(j,i))=licz(iclass(j,i))+1
277 nconf(iclass(j,i),licz(iclass(j,i)))=j
278 c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)),
279 c & nconf(iclass(j,i),licz(iclass(j,i)))
280 cd print *,j,iclass(j,i),
281 cd & licz(iclass(j,i)),nconf(iclass(j,i),licz(iclass(j,i)))
292 WRITE (iout,'(/a,1pe14.5,a/)')
293 & 'Total time for clustering:',T2-T1,' sec.'
301 close(icbase,status="delete")
303 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
305 stop '********** Program terminated normally.'
306 20 write (iout,*) "Error reading coordinates"
308 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
311 30 write (iout,*) "Error reading reference structure"
313 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
317 c---------------------------------------------------------------------------
318 double precision function difconf(icon,jcon)
321 include 'sizesclu.dat'
322 include 'COMMON.CONTROL'
323 include 'COMMON.CLUSTER'
324 include 'COMMON.CHAIN'
325 include 'COMMON.INTERACT'
327 include 'COMMON.IOUNITS'
329 double precision przes(3),obrot(3,3)
330 double precision xx(3,maxres2),yy(3,maxres2)
331 integer i,ii,j,icon,jcon
338 xx(j,ii)=allcart(j,i,jcon)
343 c if (itype(i).ne.10) then
346 xx(j,ii)=allcart(j,i+nres,jcon)
347 yy(j,ii)=cref(j,i+nres)
351 call fitsq(rms,xx(1,1),yy(1,1),ii,przes,obrot,non_conv)
355 c(j,i)=allcart(j,i,jcon)
358 call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes,
362 print *,'error, rms^2 = ',rms,icon,jcon
365 if (non_conv) print *,non_conv,icon,jcon
369 C------------------------------------------------------------------------------
370 subroutine distout(ncon)
373 include 'sizesclu.dat'
376 include 'COMMON.IOUNITS'
377 include 'COMMON.CLUSTER'
378 integer i,j,k,jlim,jlim1,nlim,ind,ioffset
381 write (iout,'(a)') 'The distance matrix'
383 nlim=min0(i+ncol-1,ncon)
384 write (iout,1000) (k,k=i,nlim)
385 write (iout,'(8h--------,10a)') ('-------',k=i,nlim)
386 1000 format (/8x,10(i4,3x))
387 1020 format (/1x,80(1h-)/)
398 IND=IOFFSET(NCON,j,k)
400 IND=IOFFSET(NCON,k,j)
403 write (iout,1010) j,(b(k),k=1,jlim-i+1)
406 1010 format (i5,3x,10(f6.2,1x))