source/cluster/wham/src/read_coords.F

   1       subroutine read_coords(ncon,*)
   2       implicit none
   3       include "DIMENSIONS"
   4       include "sizesclu.dat"
   5 #ifdef MPI
   6       include "mpif.h"
   7       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
   8       include "COMMON.MPI"
   9 #endif
  10       include "COMMON.CONTROL"
  11       include "COMMON.CHAIN"
  12       include "COMMON.INTERACT"
  13       include "COMMON.IOUNITS"
  14       include "COMMON.VAR"
  15       include "COMMON.SBRIDGE"
  16       include "COMMON.GEO"
  17       include "COMMON.CLUSTER"
  18       character*3 liczba
  19       integer ncon
  20       integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,if,ib,
  21      &  nn,nn1,inan
  22       integer ixdrf,iret,itmp
  23       real*4 prec,reini,refree,rmsdev
  24       integer nrec,nlines,iscor,lenrec,lenrec_in
  25       double precision energ,t_acq,tcpu
  26       integer ilen,iroof
  27       external ilen,iroof
  28       double precision rjunk
  29       integer ntot_all(0:maxprocs-1)
  30       logical lerr
  31       double precision energia(0:max_ene),etot
  32       real*4 csingle(3,maxres2+2)
  33       integer Previous,Next
  34       character*256 bprotfiles
  35 c      print *,"Processor",me," calls read_protein_data"
  36 #ifdef MPI
  37       if (me.eq.master) then
  38         Previous=MPI_PROC_NULL
  39       else
  40         Previous=me-1
  41       endif
  42       if (me.eq.nprocs-1) then
  43         Next=MPI_PROC_NULL
  44       else
  45         Next=me+1
  46       endif
  47 c Set the scratchfile names
  48       write (liczba,'(bz,i3.3)') me
  49 #endif
  50 c 1/27/05 AL Change stored coordinates to single precision and don't store
  51 c         energy components in the binary databases.
  52       lenrec=12*(nres+nct-nnt+1)+4*(2*nss+2)+16
  53       lenrec_in=12*(nres+nct-nnt+1)+4*(2*nss+2)+24
  54 #ifdef DEBUG
  55       write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss", nss
  56       write (iout,*) "lenrec_in",lenrec_in
  57 #endif
  58       bprotfiles=scratchdir(:ilen(scratchdir))//
  59      &       "/"//prefix(:ilen(prefix))//liczba//".xbin"
  60
  61 #ifdef CHUJ
  62       ICON=1
  63   123 continue
  64       if (from_cart .and. .not. from_bx .and. .not. from_cx) then
  65         if (efree) then
  66         read (intin,*,end=13,err=11) energy(icon),totfree(icon),
  67      &    rmstb(icon),
  68      &    nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon),
  69      &    i=1,nss_all(icon)),iscore(icon)
  70         else
  71         read (intin,*,end=13,err=11) energy(icon),rmstb(icon),
  72      &    nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon),
  73      &    i=1,nss_all(icon)),iscore(icon)
  74         endif
  75         read (intin,'(8f10.5)',end=13,err=10)
  76      &    ((allcart(j,i,icon),j=1,3),i=1,nres),
  77      &    ((allcart(j,i+nres,icon),j=1,3),i=nnt,nct)
  78         print *,icon,energy(icon),nss_all(icon),rmstb(icon)
  79       else
  80         read(intin,'(a80)',end=13,err=12) lineh
  81         read(lineh(:5),*,err=8) ic
  82         if (efree) then
  83         read(lineh(6:),*,err=8) energy(icon)
  84         else
  85         read(lineh(6:),*,err=8) energy(icon)
  86         endif
  87         goto 9
  88     8   ic=1
  89         print *,'error, assuming e=1d10',lineh
  90         energy(icon)=1d10
  91         nss=0
  92     9   continue
  93 cold        read(lineh(18:),*,end=13,err=11) nss_all(icon)
  94         ii = index(lineh(15:)," ")+15
  95         read(lineh(ii:),*,end=13,err=11) nss_all(icon)
  96         IF (NSS_all(icon).LT.9) THEN
  97           read (lineh(20:),*,end=102)
  98      &    (IHPB_all(I,icon),JHPB_all(I,icon),I=1,NSS_all(icon)),
  99      &    iscore(icon)
 100         ELSE
 101           read (lineh(20:),*,end=102)
 102      &           (IHPB_all(I,icon),JHPB_all(I,icon),I=1,8)
 103           read (intin,*) (IHPB_all(I,icon),JHPB_all(I,icon),
 104      &      I=9,NSS_all(icon)),iscore(icon)
 105         ENDIF
 106
 107   102   continue
 108
 109         PRINT *,'IC:',IC,' ENERGY:',ENERGY(ICON)
 110         call read_angles(intin,*13)
 111         do i=1,nres
 112           phiall(i,icon)=phi(i)
 113           thetall(i,icon)=theta(i)
 114           alphall(i,icon)=alph(i)
 115           omall(i,icon)=omeg(i)
 116         enddo
 117       endif
 118       ICON=ICON+1
 119       GOTO 123
 120 C
 121 C CALCULATE DISTANCES
 122 C
 123    10 print *,'something wrong with angles'
 124       goto 13
 125    11 print *,'something wrong with NSS',nss
 126       goto 13
 127    12 print *,'something wrong with header'
 128
 129    13 NCON=ICON-1
 130
 131 #endif
 132       call flush(iout)
 133       jj_old=1
 134       open (icbase,file=bprotfiles,status="unknown",
 135      &   form="unformatted",access="direct",recl=lenrec)
 136 c Read conformations from binary DA files (one per batch) and write them to
 137 c a binary DA scratchfile.
 138       jj=0
 139       jjj=0
 140 #ifdef MPI
 141       write (liczba,'(bz,i3.3)') me
 142       IF (ME.EQ.MASTER) THEN
 143 c Only the master reads the database; it'll send it to the other procs
 144 c through a ring.
 145 #endif
 146         t_acq = tcpu()
 147         icount=0
 148
 149         if (from_bx) then
 150
 151           open (intin,file=intinname,status="old",form="unformatted",
 152      &            access="direct",recl=lenrec_in)
 153
 154         else if (from_cx) then
 155 #if (defined(AIX) && !defined(JUBL))
 156           call xdrfopen_(ixdrf,intinname, "r", iret)
 157 #else
 158           call xdrfopen(ixdrf,intinname, "r", iret)
 159 #endif
 160           prec=10000.0
 161           write (iout,*) "xdrfopen: iret",iret
 162           if (iret.eq.0) then
 163             write (iout,*) "Error: coordinate file ",
 164      &       intinname(:ilen(intinname))," does not exist."
 165             call flush(iout)
 166 #ifdef MPI
 167             call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE)
 168 #endif
 169             stop
 170           endif
 171         else
 172           write (iout,*) "Error: coordinate format not specified"
 173           call flush(iout)
 174 #ifdef MPI
 175           call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE)
 176 #else
 177           stop
 178 #endif
 179         endif
 180
 181 #define DEBUG
 182 #ifdef DEBUG
 183         write (iout,*) "Opening file ",intinname(:ilen(intinname))
 184         write (iout,*) "lenrec",lenrec_in
 185         call flush(iout)
 186 #endif
 187 #undef DEBUG
 188 c        write (iout,*) "maxconf",maxconf
 189         i=0
 190         do while (.true.)
 191            i=i+1
 192            if (i.gt.maxconf) then
 193              write (iout,*) "Error: too many conformations ",
 194      &        "(",maxconf,") maximum."
 195 #ifdef MPI
 196              call MPI_Abort(MPI_COMM_WORLD,errcode,ierror)
 197 #endif
 198              stop
 199            endif
 200 c          write (iout,*) "i",i
 201 c          call flush(iout)
 202           if (from_bx) then
 203             read(intin,err=101,end=101)
 204      &       ((csingle(l,k),l=1,3),k=1,nres),
 205      &       ((csingle(l,k+nres),l=1,3),k=nnt,nct),
 206      &       nss,(ihpb(k),jhpb(k),k=1,nss),
 207      &       energy(jj+1),
 208      &       entfac(jj+1),rmstb(jj+1),iscor
 209              do j=1,2*nres
 210                do k=1,3
 211                  c(k,j)=csingle(k,j)
 212                enddo
 213              enddo
 214           else
 215 #if (defined(AIX) && !defined(JUBL))
 216             call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret)
 217             if (iret.eq.0) goto 101
 218             call xdrfint_(ixdrf, nss, iret)
 219             if (iret.eq.0) goto 101
 220             do j=1,nss
 221               call xdrfint_(ixdrf, ihpb(j), iret)
 222               if (iret.eq.0) goto 101
 223               call xdrfint_(ixdrf, jhpb(j), iret)
 224               if (iret.eq.0) goto 101
 225             enddo
 226             call xdrffloat_(ixdrf,reini,iret)
 227             if (iret.eq.0) goto 101
 228             call xdrffloat_(ixdrf,refree,iret)
 229             if (iret.eq.0) goto 101
 230             call xdrffloat_(ixdrf,rmsdev,iret)
 231             if (iret.eq.0) goto 101
 232             call xdrfint_(ixdrf,iscor,iret)
 233             if (iret.eq.0) goto 101
 234 #else
 235 c            write (iout,*) "calling xdrf3dfcoord"
 236             call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret)
 237 c            write (iout,*) "iret",iret
 238 c            call flush(iout)
 239             if (iret.eq.0) goto 101
 240             call xdrfint(ixdrf, nss, iret)
 241 c            write (iout,*) "iret",iret
 242 c            write (iout,*) "nss",nss
 243             call flush(iout)
 244             if (iret.eq.0) goto 101
 245             do k=1,nss
 246               call xdrfint(ixdrf, ihpb(k), iret)
 247               if (iret.eq.0) goto 101
 248               call xdrfint(ixdrf, jhpb(k), iret)
 249               if (iret.eq.0) goto 101
 250             enddo
 251             call xdrffloat(ixdrf,reini,iret)
 252             if (iret.eq.0) goto 101
 253             call xdrffloat(ixdrf,refree,iret)
 254             if (iret.eq.0) goto 101
 255             call xdrffloat(ixdrf,rmsdev,iret)
 256             if (iret.eq.0) goto 101
 257             call xdrfint(ixdrf,iscor,iret)
 258             if (iret.eq.0) goto 101
 259 #endif
 260             energy(jj+1)=reini
 261             entfac(jj+1)=refree
 262             rmstb(jj+1)=rmsdev
 263             do k=1,nres
 264               do l=1,3
 265                 c(l,k)=csingle(l,k)
 266               enddo
 267             enddo
 268             do k=nnt,nct
 269               do l=1,3
 270                 c(l,nres+k)=csingle(l,nres+k-nnt+1)
 271               enddo
 272             enddo
 273           endif
 274 #ifdef DEBUG
 275           write (iout,'(5hREAD ,i5,3f15.4,i10)')
 276      &     jj+1,energy(jj+1),entfac(jj+1),
 277      &     rmstb(jj+1),iscor
 278           write (iout,*) "Conformation",jjj+1,jj+1
 279           write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
 280           write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
 281           call flush(iout)
 282 #endif
 283           call add_new_cconf(jjj,jj,jj_old,icount,Next)
 284         enddo
 285   101   continue
 286         write (iout,*) i-1," conformations read from DA file ",
 287      &    intinname(:ilen(intinname))
 288         write (iout,*) jj," conformations read so far"
 289         if (from_bx) then
 290           close(intin)
 291         else
 292 #if (defined(AIX) && !defined(JUBL))
 293           call xdrfclose_(ixdrf, iret)
 294 #else
 295           call xdrfclose(ixdrf, iret)
 296 #endif
 297         endif
 298 #ifdef MPI
 299 #ifdef DEBUG
 300         write (iout,*) "jj_old",jj_old," jj",jj
 301 #endif
 302         call write_and_send_cconf(icount,jj_old,jj,Next)
 303         call MPI_Send(0,1,MPI_INTEGER,Next,570,
 304      &             MPI_COMM_WORLD,IERROR)
 305         jj_old=jj+1
 306 #else
 307         call write_and_send_cconf(icount,jj_old,jj,Next)
 308 #endif
 309         t_acq = tcpu() - t_acq
 310 #ifdef MPI
 311         write (iout,*) "Processor",me,
 312      &    " time for conformation read/send",t_acq
 313       ELSE
 314 c A worker gets the confs from the master and sends them to its neighbor
 315         t_acq = tcpu()
 316         call receive_and_pass_cconf(icount,jj_old,jj,
 317      &    Previous,Next)
 318         t_acq = tcpu() - t_acq
 319       ENDIF
 320 #endif
 321       ncon=jj
 322 c      close(icbase)
 323       close(intin)
 324
 325       write(iout,*)"A total of",ncon," conformations read."
 326
 327 #ifdef MPI
 328 c Check if everyone has the same number of conformations
 329       call MPI_Allgather(ncon,1,MPI_INTEGER,
 330      &  ntot_all(0),1,MPI_INTEGER,MPI_Comm_World,IERROR)
 331       lerr=.false.
 332       do i=0,nprocs-1
 333         if (i.ne.me) then
 334             if (ncon.ne.ntot_all(i)) then
 335               write (iout,*) "Number of conformations at processor",i,
 336      &         " differs from that at processor",me,
 337      &         ncon,ntot_all(i)
 338               lerr = .true.
 339             endif
 340         endif
 341       enddo
 342       if (lerr) then
 343         write (iout,*)
 344         write (iout,*) "Number of conformations read by processors"
 345         write (iout,*)
 346         do i=0,nprocs-1
 347           write (iout,'(8i10)') i,ntot_all(i)
 348         enddo
 349         write (iout,*) "Calculation terminated."
 350         call flush(iout)
 351         return1
 352       endif
 353       return
 354 #endif
 355  1111 write(iout,*) "Error opening coordinate file ",
 356      & intinname(:ilen(intinname))
 357       call flush(iout)
 358       return1
 359       end
 360 c------------------------------------------------------------------------------
 361       subroutine add_new_cconf(jjj,jj,jj_old,icount,Next)
 362       implicit none
 363       include "DIMENSIONS"
 364       include "sizesclu.dat"
 365       include "COMMON.CLUSTER"
 366       include "COMMON.CHAIN"
 367       include "COMMON.INTERACT"
 368       include "COMMON.LOCAL"
 369       include "COMMON.IOUNITS"
 370       include "COMMON.NAMES"
 371       include "COMMON.VAR"
 372       include "COMMON.SBRIDGE"
 373       include "COMMON.GEO"
 374       integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib
 375      &  nn,nn1,inan,Next,itj
 376       double precision etot,energia(0:max_ene)
 377       jjj=jjj+1
 378       call int_from_cart1(.false.)
 379       do j=nnt+1,nct
 380         if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
 381           write (iout,*) "Conformation",jjj,jj+1
 382           write (iout,*) "Bad CA-CA bond length",j," ",vbld(j)
 383           write (iout,*) "The Cartesian geometry is:"
 384           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 385           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 386           write (iout,*) "The internal geometry is:"
 387           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 388           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 389           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 390           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 391           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 392           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 393           write (iout,*)
 394      &      "This conformation WILL NOT be added to the database."
 395           return
 396         endif
 397       enddo
 398       do j=nnt,nct
 399         itj=itype(j)
 400         if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0)
 401      & then
 402           write (iout,*) "Conformation",jjj,jj+1
 403           write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
 404           write (iout,*) "The Cartesian geometry is:"
 405           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 406           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 407           write (iout,*) "The internal geometry is:"
 408           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 409           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 410           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 411           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 412           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 413           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 414           write (iout,*)
 415      &      "This conformation WILL NOT be added to the database."
 416           return
 417         endif
 418       enddo
 419       do j=3,nres
 420         if (theta(j).le.0.0d0) then
 421           write (iout,*)
 422      &      "Zero theta angle(s) in conformation",jjj,jj+1
 423           write (iout,*) "The Cartesian geometry is:"
 424           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 425           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 426           write (iout,*) "The internal geometry is:"
 427           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 428           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 429           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 430           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 431           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 432           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 433           write (iout,*)
 434      &      "This conformation WILL NOT be added to the database."
 435           return
 436         endif
 437         if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
 438       enddo
 439       jj=jj+1
 440 #ifdef DEBUG
 441       write (iout,*) "Conformation",jjj,jj
 442       write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
 443       write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
 444       write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 445       write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 446       write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 447       write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 448       write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
 449       write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 450       write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 451       write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
 452       write (iout,'(e15.5,16i5)') entfac(icount+1),
 453      &        iscore(icount+1,0)
 454 #endif
 455       icount=icount+1
 456       call store_cconf_from_file(jj,icount)
 457       if (icount.eq.maxstr_proc) then
 458 #ifdef DEBUG
 459         write (iout,* ) "jj_old",jj_old," jj",jj
 460 #endif
 461         call write_and_send_cconf(icount,jj_old,jj,Next)
 462         jj_old=jj+1
 463         icount=0
 464       endif
 465       return
 466       end
 467 c------------------------------------------------------------------------------
 468       subroutine store_cconf_from_file(jj,icount)
 469       implicit none
 470       include "DIMENSIONS"
 471       include "sizesclu.dat"
 472       include "COMMON.CLUSTER"
 473       include "COMMON.CHAIN"
 474       include "COMMON.SBRIDGE"
 475       include "COMMON.INTERACT"
 476       include "COMMON.IOUNITS"
 477       include "COMMON.VAR"
 478       integer i,j,jj,icount
 479 c Store the conformation that has been read in
 480       do i=1,2*nres
 481         do j=1,3
 482           allcart(j,i,icount)=c(j,i)
 483         enddo
 484       enddo
 485       nss_all(icount)=nss
 486       do i=1,nss
 487         ihpb_all(i,icount)=ihpb(i)
 488         jhpb_all(i,icount)=jhpb(i)
 489       enddo
 490       return
 491       end
 492 c------------------------------------------------------------------------------
 493       subroutine write_and_send_cconf(icount,jj_old,jj,Next)
 494       implicit none
 495       include "DIMENSIONS"
 496       include "sizesclu.dat"
 497 #ifdef MPI
 498       include "mpif.h"
 499       integer IERROR
 500       include "COMMON.MPI"
 501 #endif
 502       include "COMMON.CHAIN"
 503       include "COMMON.SBRIDGE"
 504       include "COMMON.INTERACT"
 505       include "COMMON.IOUNITS"
 506       include "COMMON.CLUSTER"
 507       include "COMMON.VAR"
 508       integer icount,jj_old,jj,Next
 509 c Write the structures to a scratch file
 510 #ifdef MPI
 511 c Master sends the portion of conformations that have been read in to the neighbor
 512 #ifdef DEBUG
 513       write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
 514       call flush(iout)
 515 #endif
 516       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
 517       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
 518      &    Next,571,MPI_COMM_WORLD,IERROR)
 519       call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
 520      &    Next,572,MPI_COMM_WORLD,IERROR)
 521       call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
 522      &    Next,573,MPI_COMM_WORLD,IERROR)
 523       call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 524      &    Next,577,MPI_COMM_WORLD,IERROR)
 525       call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 526      &    Next,579,MPI_COMM_WORLD,IERROR)
 527       call MPI_Send(allcart(1,1,1),3*icount*maxres2,
 528      &    MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 529 #endif
 530       call dawrite_ccoords(jj_old,jj,icbase)
 531       return
 532       end
 533 c------------------------------------------------------------------------------
 534 #ifdef MPI
 535       subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,
 536      &  Next)
 537       implicit none
 538       include "DIMENSIONS"
 539       include "sizesclu.dat"
 540       include "mpif.h"
 541       integer IERROR,STATUS(MPI_STATUS_SIZE)
 542       include "COMMON.MPI"
 543       include "COMMON.CHAIN"
 544       include "COMMON.SBRIDGE"
 545       include "COMMON.INTERACT"
 546       include "COMMON.IOUNITS"
 547       include "COMMON.VAR"
 548       include "COMMON.GEO"
 549       include "COMMON.CLUSTER"
 550       integer i,j,k,icount,jj_old,jj,Previous,Next
 551       icount=1
 552 #ifdef DEBUG
 553       write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
 554       call flush(iout)
 555 #endif
 556       do while (icount.gt.0)
 557       call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
 558      &     STATUS,IERROR)
 559       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,
 560      &     IERROR)
 561 #ifdef DEBUG
 562       write (iout,*) "Processor",me," icount",icount
 563 #endif
 564       if (icount.eq.0) return
 565       call MPI_Recv(nss_all(1),icount,MPI_INTEGER,
 566      &    Previous,571,MPI_COMM_WORLD,STATUS,IERROR)
 567       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
 568      &  Next,571,MPI_COMM_WORLD,IERROR)
 569       call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,
 570      &    Previous,572,MPI_COMM_WORLD,STATUS,IERROR)
 571       call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
 572      &  Next,572,MPI_COMM_WORLD,IERROR)
 573       call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,
 574      &    Previous,573,MPI_COMM_WORLD,STATUS,IERROR)
 575       call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
 576      &  Next,573,MPI_COMM_WORLD,IERROR)
 577       call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 578      &  Previous,577,MPI_COMM_WORLD,STATUS,IERROR)
 579       call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 580      &  Next,577,MPI_COMM_WORLD,IERROR)
 581       call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 582      &  Previous,579,MPI_COMM_WORLD,STATUS,IERROR)
 583       call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 584      &  Next,579,MPI_COMM_WORLD,IERROR)
 585       call MPI_Recv(allcart(1,1,1),3*icount*maxres2,
 586      &  MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR)
 587       call MPI_Send(allcart(1,1,1),3*icount*maxres2,
 588      &  MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 589       jj=jj_old+icount-1
 590       call dawrite_ccoords(jj_old,jj,icbase)
 591       jj_old=jj+1
 592 #ifdef DEBUG
 593       write (iout,*) "Processor",me," received",icount," conformations"
 594       do i=1,icount
 595         write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
 596         write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
 597         write (iout,'(e15.5,16i5)') entfac(i)
 598       enddo
 599 #endif
 600       enddo
 601       return
 602       end
 603 #endif
 604 c------------------------------------------------------------------------------
 605       subroutine daread_ccoords(istart_conf,iend_conf)
 606       implicit none
 607       include "DIMENSIONS"
 608       include "sizesclu.dat"
 609 #ifdef MPI
 610       include "mpif.h"
 611       include "COMMON.MPI"
 612 #endif
 613       include "COMMON.CHAIN"
 614       include "COMMON.CLUSTER"
 615       include "COMMON.IOUNITS"
 616       include "COMMON.INTERACT"
 617       include "COMMON.VAR"
 618       include "COMMON.SBRIDGE"
 619       include "COMMON.GEO"
 620       integer istart_conf,iend_conf
 621       integer i,j,ij,ii,iii
 622       integer len
 623       character*16 form,acc
 624       character*32 nam
 625 c
 626 c Read conformations off a DA scratchfile.
 627 c
 628 #ifdef DEBUG
 629       write (iout,*) "DAREAD_COORDS"
 630       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
 631       inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
 632       write (iout,*) "len=",len," form=",form," acc=",acc
 633       write (iout,*) "nam=",nam
 634       call flush(iout)
 635 #endif
 636       do ii=istart_conf,iend_conf
 637         ij = ii - istart_conf + 1
 638         iii=list_conf(ii)
 639 #ifdef DEBUG
 640         write (iout,*) "Reading binary file, record",iii," ii",ii
 641         call flush(iout)
 642 #endif
 643         read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
 644      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
 645      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
 646      &    entfac(ii),rmstb(ii)
 647 #ifdef DEBUG
 648         write (iout,*) ii,iii,ij,entfac(ii)
 649         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
 650         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),
 651      &    i=nnt+nres,nct+nres)
 652         write (iout,'(2e15.5)') entfac(ij)
 653         write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
 654      &    jhpb_all(i,ij),i=1,nss)
 655         call flush(iout)
 656 #endif
 657       enddo
 658       return
 659       end
 660 c------------------------------------------------------------------------------
 661       subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out)
 662       implicit none
 663       include "DIMENSIONS"
 664       include "sizesclu.dat"
 665 #ifdef MPI
 666       include "mpif.h"
 667       include "COMMON.MPI"
 668 #endif
 669       include "COMMON.CHAIN"
 670       include "COMMON.INTERACT"
 671       include "COMMON.IOUNITS"
 672       include "COMMON.VAR"
 673       include "COMMON.SBRIDGE"
 674       include "COMMON.GEO"
 675       include "COMMON.CLUSTER"
 676       integer istart_conf,iend_conf
 677       integer i,j,ii,ij,iii,unit_out
 678       integer len
 679       character*16 form,acc
 680       character*32 nam
 681 c
 682 c Write conformations to a DA scratchfile.
 683 c
 684 #ifdef DEBUG
 685       write (iout,*) "DAWRITE_COORDS"
 686       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
 687       write (iout,*) "lenrec",lenrec
 688       inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
 689       write (iout,*) "len=",len," form=",form," acc=",acc
 690       write (iout,*) "nam=",nam
 691       call flush(iout)
 692 #endif
 693       do ii=istart_conf,iend_conf
 694         iii=list_conf(ii)
 695         ij = ii - istart_conf + 1
 696 #ifdef DEBUG
 697         write (iout,*) "Writing binary file, record",iii," ii",ii
 698         call flush(iout)
 699 #endif
 700         write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
 701      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
 702      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
 703      &    entfac(ii),rmstb(ii)
 704 #ifdef DEBUG
 705         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
 706         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
 707      &   nct+nres)
 708         write (iout,'(2e15.5)') entfac(ij)
 709         write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,
 710      &   nss_all(ij))
 711         call flush(iout)
 712 #endif
 713       enddo
 714       return
 715       end