X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fcluster%2Fwham%2Fsrc-M%2Fmain_clust.F;h=016424958218f75248ebb2a004aa0ee9877cae07;hb=34d3ad3987785642be58fb2f26557d3314215577;hp=f01f859d7ae828dba581b421daf68f086d71d32e;hpb=f690e8b70bab14132839afebf080d4a28363b226;p=unres.git diff --git a/source/cluster/wham/src-M/main_clust.F b/source/cluster/wham/src-M/main_clust.F index f01f859..0164249 100644 --- a/source/cluster/wham/src-M/main_clust.F +++ b/source/cluster/wham/src-M/main_clust.F @@ -29,12 +29,12 @@ C INTEGER IA(maxconf),IB(maxconf) INTEGER ICLASS(maxconf,maxconf-1),HVALS(maxconf-1) INTEGER IORDER(maxconf-1),HEIGHT(maxconf-1) - integer nn,ndis - real*4 DISNN + integer nn,ndis,scount_buf + real*4 DISNN, diss_buf(maxdist) DIMENSION NN(maxconf),DISNN(maxconf) LOGICAL FLAG(maxconf) integer i,j,k,l,m,n,len,lev,idum,ii,ind,ioffset,jj,icut,ncon, - & it,ncon_work,ind1 + & it,ncon_work,ind1,kkk, ijk, is,ie double precision t1,t2,tcpu,difconf double precision varia(maxvar) @@ -61,10 +61,12 @@ C call initialize call openunits - call parmread + call cinfo call read_control + call parmread call molread -c if (refstr) call read_ref_structure(*30) +c write (iout,*) "Main: refstr ",refstr + if (refstr) call read_ref_structure(*30) do i=1,nres phi(i)=0.0D0 theta(i)=0.0D0 @@ -77,8 +79,13 @@ c call flush(iout) call permut(symetr) c write (iout,*) "after permut" c call flush(iout) - print *,'MAIN: nnt=',nnt,' nct=',nct - +c print *,'MAIN: nnt=',nnt,' nct=',nct + if (nclust.gt.0) then + PRINTANG(1)=.TRUE. + PRINTPDB(1)=outpdb + printmol2(1)=outmol2 + ncut=0 + else DO I=1,NCUT PRINTANG(I)=.FALSE. PRINTPDB(I)=0 @@ -90,12 +97,21 @@ c call flush(iout) printmol2(i)=outmol2 ENDIF ENDDO + endif + if (ncut.gt.0) then write (iout,*) 'Number of cutoffs:',NCUT write (iout,*) 'Cutoff values:' DO ICUT=1,NCUT WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT), & printpdb(icut),printmol2(icut) ENDDO + else if (nclust.gt.0) then + write (iout,'("Number of clusters requested",i5)') nclust + else + if (me.eq.Master) + & write (iout,*) "ERROR: Either nclust or ncut must be >0" + stop + endif DO I=1,NRES-3 MULT(I)=1 ENDDO @@ -107,11 +123,10 @@ c call flush(iout) write (iout,*) "nT",nT do iT=1,nT - write (iout,*) "iT",iT + write (iout,*) "Temperature",1.0d0/(beta_h(iT)*1.987D-3) #ifdef MPI call work_partition(.true.,ncon) #endif - call probabl(iT,ncon_work,ncon,*20) if (ncon_work.lt.2) then @@ -122,7 +137,6 @@ c call flush(iout) ndis=ncon_work*(ncon_work-1)/2 call work_partition(.true.,ndis) #endif - DO I=1,NCON_work ICC(I)=I ENDDO @@ -134,15 +148,16 @@ C call daread_ccoords(1,ncon_work) ind1=0 DO I=1,NCON_work-1 - if (mod(i,100).eq.0) print *,'Calculating RMS i=',i +c if (mod(i,100).eq.0) print *,'Calculating RMS i=',i do k=1,2*nres do l=1,3 c(l,k)=allcart(l,k,i) enddo enddo + kkk=1 do k=1,nres do l=1,3 - cref(l,k)=c(l,k) + cref(l,k,kkk)=c(l,k) enddo enddo DO J=I+1,NCON_work @@ -162,10 +177,18 @@ c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND) WRITE (iout,'(/a,1pe14.5,a/)') & 'Time for distance calculation:',T2-T1,' sec.' t1=tcpu() - PRINT '(a)','End of distance computation' +c PRINT '(a)','End of distance computation' + + scount_buf=scount(me) + + do ijk=1, ndis + diss_buf(ijk)=diss(ijk) + enddo + #ifdef MPI - call MPI_Gatherv(diss(1),scount(me),MPI_REAL,diss(1), + WRITE (iout,*) "Wchodze do call MPI_Gatherv" + call MPI_Gatherv(diss_buf(1),scount_buf,MPI_REAL,diss(1), & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR) if (me.eq.master) then #endif @@ -241,21 +264,29 @@ C endif CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL) - +c 3/3/16 AL: added explicit number of cluters + if (nclust.gt.0) then + is=nclust-1 + ie=nclust-1 + icut=1 + else + is=1 + ie=lev-1 + endif do i=1,maxgr licz(i)=0 enddo icut=1 - i=1 - NGR=i+1 + i=is + NGR=is+1 do j=1,n licz(iclass(j,i))=licz(iclass(j,i))+1 nconf(iclass(j,i),licz(iclass(j,i)))=j c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)), c & nconf(iclass(j,i),licz(iclass(j,i))) enddo - do i=1,lev-1 - +c do i=1,lev-1 + do i=is,ie idum=lev-i DO L=1,LEV IF (HEIGHT(L).EQ.IDUM) GOTO 190 @@ -263,8 +294,9 @@ c & nconf(iclass(j,i),licz(iclass(j,i))) 190 IDUM=L write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM), & " icut",icut," cutoff",rcutoff(icut) - IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN - WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut) + IF (nclust.gt.0.or.CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN + if (nclust.le.0) + & WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut) write (iout,'(a,f8.2)') 'Maximum distance found:', & CRITVAL(IDUM) CALL SRTCLUST(ICUT,ncon_work,iT) @@ -305,17 +337,17 @@ C C close(icbase,status="delete") #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop '********** Program terminated normally.' 20 write (iout,*) "Error reading coordinates" #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop 30 write (iout,*) "Error reading reference structure" #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop end @@ -333,7 +365,7 @@ c--------------------------------------------------------------------------- logical non_conv double precision przes(3),obrot(3,3) double precision xx(3,maxres2),yy(3,maxres2) - integer i,ii,j,icon,jcon,kkk,nperm,chalen,zzz + integer i,ii,j,icon,jcon,kkk,chalen,zzz integer iaperm,ibezperm,run double precision rms,rmsmina c write (iout,*) "tu dochodze" @@ -358,7 +390,7 @@ c write (iout,*) "tutaj",zzz ibezperm=(run-1)*chalen+i do j=1,3 xx(j,ii)=allcart(j,iaperm,jcon) - yy(j,ii)=cref(j,ibezperm) + yy(j,ii)=cref(j,ibezperm,kkk) enddo enddo enddo @@ -372,7 +404,7 @@ c if (itype(i).ne.10) then ii=ii+1 do j=1,3 xx(j,ii)=allcart(j,iaperm+nres,jcon) - yy(j,ii)=cref(j,ibezperm+nres) + yy(j,ii)=cref(j,ibezperm+nres,kkk) enddo enddo c endif @@ -392,7 +424,8 @@ c do i=nnt,nct enddo enddo enddo - call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes, + call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1, + & przes, & obrot,non_conv) endif if (rms.lt.0.0) then