update
[unres.git] / source / cluster / wham / src-M / read_coords.F
index c34aca4..facbc27 100644 (file)
@@ -62,7 +62,7 @@ c         energy components in the binary databases.
       ICON=1
   123 continue
       if (from_cart .and. .not. from_bx .and. .not. from_cx) then
-        if (efree) then
+        if (lefree) then
         read (intin,*,end=13,err=11) energy(icon),totfree(icon),
      &    rmstb(icon),
      &    nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon),
@@ -79,7 +79,7 @@ c         energy components in the binary databases.
       else 
         read(intin,'(a80)',end=13,err=12) lineh
         read(lineh(:5),*,err=8) ic
-        if (efree) then
+        if (lefree) then
         read(lineh(6:),*,err=8) energy(icon)
         else
         read(lineh(6:),*,err=8) energy(icon)
@@ -178,13 +178,13 @@ c through a ring.
 #endif
         endif
 
-#define DEBUG
+C#define DEBUG
 #ifdef DEBUG
         write (iout,*) "Opening file ",intinname(:ilen(intinname))
         write (iout,*) "lenrec",lenrec_in
         call flush(iout)
 #endif
-#undef DEBUG
+C#undef DEBUG
 c        write (iout,*) "maxconf",maxconf
         i=0
         do while (.true.)
@@ -218,10 +218,17 @@ c          call flush(iout)
             call xdrfint_(ixdrf, nss, iret)
             if (iret.eq.0) goto 101
             do j=1,nss
+           if (dyn_ss) then
+            call xdrfint(ixdrf, idssb(j), iret)
+            call xdrfint(ixdrf, jdssb(j), iret)
+        idssb(j)=idssb(j)-nres
+        jdssb(j)=jdssb(j)-nres
+           else
               call xdrfint_(ixdrf, ihpb(j), iret)
               if (iret.eq.0) goto 101
               call xdrfint_(ixdrf, jhpb(j), iret)
               if (iret.eq.0) goto 101
+           endif
             enddo
             call xdrffloat_(ixdrf,reini,iret)
             if (iret.eq.0) goto 101
@@ -243,10 +250,15 @@ c            write (iout,*) "nss",nss
             call flush(iout)
             if (iret.eq.0) goto 101
             do k=1,nss
+           if (dyn_ss) then
+            call xdrfint(ixdrf, idssb(k), iret)
+            call xdrfint(ixdrf, jdssb(k), iret)
+            else
               call xdrfint(ixdrf, ihpb(k), iret)
               if (iret.eq.0) goto 101
               call xdrfint(ixdrf, jhpb(k), iret)
               if (iret.eq.0) goto 101
+            endif
             enddo
             call xdrffloat(ixdrf,reini,iret)
             if (iret.eq.0) goto 101
@@ -260,6 +272,10 @@ c            write (iout,*) "nss",nss
             energy(jj+1)=reini
             entfac(jj+1)=refree
             rmstb(jj+1)=rmsdev
+#ifdef DEBUG
+            write (iout,*) "jj",jj+1," energy",energy(jj+1),
+     &         " entfac",entfac(jj+1)," rmsd",rmstb(jj+1)
+#endif
             do k=1,nres
               do l=1,3
                 c(l,k)=csingle(l,k)
@@ -271,6 +287,7 @@ c            write (iout,*) "nss",nss
               enddo
             enddo
           endif
+C#define DEBUG
 #ifdef DEBUG
           write (iout,'(5hREAD ,i5,3f15.4,i10)') 
      &     jj+1,energy(jj+1),entfac(jj+1),
@@ -280,6 +297,7 @@ c            write (iout,*) "nss",nss
           write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
           call flush(iout)
 #endif
+C#undef DEBUG
           call add_new_cconf(jjj,jj,jj_old,icount,Next)
         enddo
   101   continue
@@ -296,9 +314,9 @@ c            write (iout,*) "nss",nss
 #endif
         endif
 #ifdef MPI
-c#ifdef DEBUG  
+#ifdef DEBUG   
         write (iout,*) "jj_old",jj_old," jj",jj
-c#endif
+#endif
         call write_and_send_cconf(icount,jj_old,jj,Next)
         call MPI_Send(0,1,MPI_INTEGER,Next,570,
      &             MPI_COMM_WORLD,IERROR)
@@ -379,7 +397,8 @@ c------------------------------------------------------------------------------
       chalen=int((nct-nnt+2)/symetr)
       call int_from_cart1(.false.)
       do j=nnt+1,nct
-        if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
+        if ((vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)
+     &      .and.(itype(j).ne.ntyp1)) then
          if (j.gt.2) then
           if (itel(j).ne.0 .and. itel(j-1).ne.0) then
           write (iout,*) "Conformation",jjj,jj+1
@@ -404,7 +423,8 @@ c------------------------------------------------------------------------------
       enddo
       do j=nnt,nct
         itj=itype(j)
-        if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
+        if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0
+     &  .and. itype(j).ne.ntyp1) then
           write (iout,*) "Conformation",jjj,jj+1
           write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
           write (iout,*) "The Cartesian geometry is:"
@@ -534,6 +554,10 @@ c Master sends the portion of conformations that have been read in to the neighb
      &    MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 #endif
       call dawrite_ccoords(jj_old,jj,icbase)
+#ifdef DEBUG
+      write (iout,*) "Processor",me," exit WRITE_AND_SEND_CONF"
+      call flush(iout)
+#endif
       return
       end
 c------------------------------------------------------------------------------
@@ -553,7 +577,7 @@ c------------------------------------------------------------------------------
       include "COMMON.VAR"
       include "COMMON.GEO"
       include "COMMON.CLUSTER"
-      integer i,j,k,icount,jj_old,jj,Previous,Next
+      integer i,j,k,l,icount,jj_old,jj,Previous,Next
       icount=1
 #ifdef DEBUG
       write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
@@ -598,8 +622,8 @@ c------------------------------------------------------------------------------
 #ifdef DEBUG
       write (iout,*) "Processor",me," received",icount," conformations"
       do i=1,icount
-        write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
-        write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
+        write (iout,'(8f10.4)') ((allcart(l,k,i),l=1,3),k=1,nres)
+        write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3),k=nnt,nct)
         write (iout,'(e15.5,16i5)') entfac(i)
       enddo
 #endif
@@ -627,10 +651,11 @@ c------------------------------------------------------------------------------
       integer i,j,ij,ii,iii
       integer len
       character*16 form,acc
-      character*32 nam
+      character*80 nam
 c
 c Read conformations off a DA scratchfile.
 c
+C#define DEBUG
 #ifdef DEBUG
       write (iout,*) "DAREAD_COORDS"
       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
@@ -646,10 +671,17 @@ c
         write (iout,*) "Reading binary file, record",iii," ii",ii
         call flush(iout)
 #endif
+        if (dyn_ss) then
+        read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
+     &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
+c     &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
+     &    entfac(ii),rmstb(ii)
+        else
         read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
      &    entfac(ii),rmstb(ii)
+         endif
 #ifdef DEBUG
         write (iout,*) ii,iii,ij,entfac(ii)
         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
@@ -660,7 +692,10 @@ c
      &    jhpb_all(i,ij),i=1,nss)
         call flush(iout)
 #endif
+C#undef DEBUG
       enddo
+c      write (iout,*) "just before leave"
+      call flush(iout)
       return
       end
 c------------------------------------------------------------------------------
@@ -703,10 +738,17 @@ c
         write (iout,*) "Writing binary file, record",iii," ii",ii
         call flush(iout)
 #endif
+       if (dyn_ss) then
+        write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
+     &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
+c     &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij))
+     &    entfac(ii),rmstb(ii)
+        else
         write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
      &    entfac(ii),rmstb(ii)
+       endif
 #ifdef DEBUG
         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,