Merge branch 'lipid' of mmka.chem.univ.gda.pl:unres into lipid
authorAdam Liwo <adam@piasek4.chem.univ.gda.pl>
Sat, 31 Oct 2015 18:01:40 +0000 (19:01 +0100)
committerAdam Liwo <adam@piasek4.chem.univ.gda.pl>
Sat, 31 Oct 2015 18:01:40 +0000 (19:01 +0100)
1  2 
source/wham/src-M/enecalc1.F

@@@ -35,7 -35,7 +35,7 @@@
        double precision tole /1.0d-1/
        integer i,itj,ii,iii,j,k,l,licz
        integer ir,ib,ipar,iparm
-       integer iscor,islice
+       integer iscor,islice,scount_buff(0:99)
        real*4 csingle(3,maxres2)
        double precision energ
        double precision temp
@@@ -160,17 -160,14 +160,17 @@@ c     &   " kfac",kfac,"quot",quot," fT
  C        write (iout,*) "tuz przed energia"
          call etotal(energia(0),fT)
  C        write (iout,*) "tuz za energia"
 -
 +#define DEBUG
  #ifdef DEBUG
          write (iout,*) "Conformation",i
            write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
            write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
          call enerprint(energia(0),fT)
 +#endif
 +#undef DEBUG
 +#ifdef DEBUG
          write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
-         write (iout,*) "ftors",ftors
+         write (iout,*) "ftors(1)",ftors(1)
          call briefout(i,energia(0))
          temp=1.0d0/(beta_h(ib,ipar)*1.987D-3)
          write (iout,*) "temp", temp
@@@ -280,12 -277,15 +280,15 @@@ c     &   " snk",snk_p(iR,ib,ipar
    121   continue
        enddo   
  #ifdef MPI
-       scount(me)=iii 
-       write (iout,*) "Me",me," scount",scount(me)
+       scount_buff(me)=iii 
+       write (iout,*) "Me",me," scount_buff",scount_buff(me)
        call flush(iout)
  c  Master gathers updated numbers of conformations written by all procs.
-       call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1, 
+ c      call MPI_AllGather(MPI_IN_PLACE,1,MPI_DATATYPE_NULL,scount(0),1,
+ c     &  MPI_INTEGER, WHAM_COMM, IERROR)
+       call MPI_AllGather( scount_buff(me), 1, MPI_INTEGER, scount(0), 1,
       &  MPI_INTEGER, WHAM_COMM, IERROR)
        indstart(0)=1
        indend(0)=scount(0)
        do i=1, Nprocs-1
@@@ -371,7 -371,7 +374,7 @@@ c--------------------------------------
        double precision energ
        integer ilen,iroof
        external ilen,iroof
-       integer ir,ib,iparm
+       integer ir,ib,iparm, scount_buff(0:99)
        integer isecstr(maxres)
        write (licz2,'(bz,i2.2)') islice
        call opentmp(islice,ientout,bprotfile_temp)
@@@ -676,8 -676,13 +679,13 @@@ c      write (iout,*) "xdrf3dfcoord
  c      call flush(iout)
        call xdrfint_(ixdrf, nss, iret)
        do j=1,nss
-         call xdrfint_(ixdrf, ihpb(j), iret)
-         call xdrfint_(ixdrf, jhpb(j), iret)
+            if (dyn_ss) then
+             call xdrfint(ixdrf, idssb(j)+nres, iret)
+             call xdrfint(ixdrf, jdssb(j)+nres, iret)
+            else
+             call xdrfint_(ixdrf, ihpb(j), iret)
+             call xdrfint_(ixdrf, jhpb(j), iret)
+            endif
        enddo
        call xdrffloat_(ixdrf,real(eini),iret) 
        call xdrffloat_(ixdrf,real(efree),iret) 
  
        call xdrfint(ixdrf, nss, iret)
        do j=1,nss
-         call xdrfint(ixdrf, ihpb(j), iret)
-         call xdrfint(ixdrf, jhpb(j), iret)
+            if (dyn_ss) then
+             call xdrfint(ixdrf, idssb(j)+nres, iret)
+             call xdrfint(ixdrf, jdssb(j)+nres, iret)
+            else
+             call xdrfint(ixdrf, ihpb(j), iret)
+             call xdrfint(ixdrf, jhpb(j), iret)
+            endif
        enddo
        call xdrffloat(ixdrf,real(eini),iret) 
        call xdrffloat(ixdrf,real(efree),iret) 
@@@ -733,11 -743,36 +746,36 @@@ c--------------------------------------
        endif
        call int_from_cart1(.false.)
        do j=nnt+1,nct
+         if (wliptran.gt.0d0) then
+         if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and.
+      &    (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.3d0)) then
+           if (iprint.gt.0)
+      &    write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
+      &      " for conformation",ii,wliptran
+           if (iprint.gt.1) then
+             write (iout,*) "The Cartesian geometry is:"
+             write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
+             write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
+             write (iout,*) "The internal geometry is:"
+             write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
+             write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
+             write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
+             write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
+             write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
+             write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
+           endif
+           if (iprint.gt.0) write (iout,*)
+      &      "This conformation WILL NOT be added to the database."
+           conf_check=.false.
+           return
+         endif
+         else
          if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and. 
       &    (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then
            if (iprint.gt.0) 
       &    write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
-      &      " for conformation",ii
+      &      " for conformation",ii,wliptran
            if (iprint.gt.1) then
              write (iout,*) "The Cartesian geometry is:"
              write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
            conf_check=.false.
            return
          endif
+         endif
        enddo
        do j=nnt,nct
          itj=itype(j)