update
[unres.git] / source / cluster / wham / src-M / main_clust.F
index f01f859..0164249 100644 (file)
@@ -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