source/cluster/wham/src-M/bakup/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             write (iout,*) "calling xdrf3dfcoord"
 236             call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret)
 237             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 c#ifdef DEBUG
 300         write (iout,*) "jj_old",jj_old," jj",jj
 301 c#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.CONTROL"
 367       include "COMMON.CHAIN"
 368       include "COMMON.INTERACT"
 369       include "COMMON.LOCAL"
 370       include "COMMON.IOUNITS"
 371       include "COMMON.NAMES"
 372       include "COMMON.VAR"
 373       include "COMMON.SBRIDGE"
 374       include "COMMON.GEO"
 375       integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib
 376      &  nn,nn1,inan,Next,itj,chalen
 377       double precision etot,energia(0:max_ene)
 378       jjj=jjj+1
 379       chalen=int((nct-nnt+2)/symetr)
 380       call int_from_cart1(.false.)
 381       do j=nnt+1,nct
 382         if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
 383          if (j.gt.2) then
 384           if (itel(j).ne.0 .and. itel(j-1).ne.0) then
 385           write (iout,*) "Conformation",jjj,jj+1
 386           write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j),
 387      & chalen
 388           write (iout,*) "The Cartesian geometry is:"
 389           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 390           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 391           write (iout,*) "The internal geometry is:"
 392           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 393           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 394           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 395           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 396           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 397           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 398           write (iout,*)
 399      &      "This conformation WILL NOT be added to the database."
 400           return
 401           endif
 402          endif
 403         endif
 404       enddo
 405       do j=nnt,nct
 406         itj=itype(j)
 407         if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
 408           write (iout,*) "Conformation",jjj,jj+1
 409           write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
 410           write (iout,*) "The Cartesian geometry is:"
 411           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 412           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 413           write (iout,*) "The internal geometry is:"
 414           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 415           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 416           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 417           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 418           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 419           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 420           write (iout,*)
 421      &      "This conformation WILL NOT be added to the database."
 422           return
 423         endif
 424       enddo
 425       do j=3,nres
 426         if (theta(j).le.0.0d0) then
 427           write (iout,*)
 428      &      "Zero theta angle(s) in conformation",jjj,jj+1
 429           write (iout,*) "The Cartesian geometry is:"
 430           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 431           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 432           write (iout,*) "The internal geometry is:"
 433           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 434           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 435           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 436           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 437           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 438           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 439           write (iout,*)
 440      &      "This conformation WILL NOT be added to the database."
 441           return
 442         endif
 443         if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
 444       enddo
 445       jj=jj+1
 446 #ifdef DEBUG
 447       write (iout,*) "Conformation",jjj,jj
 448       write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
 449       write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
 450       write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 451       write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 452       write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 453       write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 454       write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
 455       write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 456       write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 457       write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
 458       write (iout,'(e15.5,16i5)') entfac(icount+1)
 459 c     &        iscore(icount+1,0)
 460 #endif
 461       icount=icount+1
 462       call store_cconf_from_file(jj,icount)
 463       if (icount.eq.maxstr_proc) then
 464 #ifdef DEBUG
 465         write (iout,* ) "jj_old",jj_old," jj",jj
 466 #endif
 467         call write_and_send_cconf(icount,jj_old,jj,Next)
 468         jj_old=jj+1
 469         icount=0
 470       endif
 471       return
 472       end
 473 c------------------------------------------------------------------------------
 474       subroutine store_cconf_from_file(jj,icount)
 475       implicit none
 476       include "DIMENSIONS"
 477       include "sizesclu.dat"
 478       include "COMMON.CLUSTER"
 479       include "COMMON.CHAIN"
 480       include "COMMON.SBRIDGE"
 481       include "COMMON.INTERACT"
 482       include "COMMON.IOUNITS"
 483       include "COMMON.VAR"
 484       integer i,j,jj,icount
 485 c Store the conformation that has been read in
 486       do i=1,2*nres
 487         do j=1,3
 488           allcart(j,i,icount)=c(j,i)
 489         enddo
 490       enddo
 491       nss_all(icount)=nss
 492       do i=1,nss
 493         ihpb_all(i,icount)=ihpb(i)
 494         jhpb_all(i,icount)=jhpb(i)
 495       enddo
 496       return
 497       end
 498 c------------------------------------------------------------------------------
 499       subroutine write_and_send_cconf(icount,jj_old,jj,Next)
 500       implicit none
 501       include "DIMENSIONS"
 502       include "sizesclu.dat"
 503 #ifdef MPI
 504       include "mpif.h"
 505       integer IERROR
 506       include "COMMON.MPI"
 507 #endif
 508       include "COMMON.CHAIN"
 509       include "COMMON.SBRIDGE"
 510       include "COMMON.INTERACT"
 511       include "COMMON.IOUNITS"
 512       include "COMMON.CLUSTER"
 513       include "COMMON.VAR"
 514       integer icount,jj_old,jj,Next
 515 c Write the structures to a scratch file
 516 #ifdef MPI
 517 c Master sends the portion of conformations that have been read in to the neighbor
 518 #ifdef DEBUG
 519       write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
 520       call flush(iout)
 521 #endif
 522       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
 523       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
 524      &    Next,571,MPI_COMM_WORLD,IERROR)
 525       call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
 526      &    Next,572,MPI_COMM_WORLD,IERROR)
 527       call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
 528      &    Next,573,MPI_COMM_WORLD,IERROR)
 529       call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 530      &    Next,577,MPI_COMM_WORLD,IERROR)
 531       call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 532      &    Next,579,MPI_COMM_WORLD,IERROR)
 533       call MPI_Send(allcart(1,1,1),3*icount*maxres2,
 534      &    MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 535 #endif
 536       call dawrite_ccoords(jj_old,jj,icbase)
 537       return
 538       end
 539 c------------------------------------------------------------------------------
 540 #ifdef MPI
 541       subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,
 542      &  Next)
 543       implicit none
 544       include "DIMENSIONS"
 545       include "sizesclu.dat"
 546       include "mpif.h"
 547       integer IERROR,STATUS(MPI_STATUS_SIZE)
 548       include "COMMON.MPI"
 549       include "COMMON.CHAIN"
 550       include "COMMON.SBRIDGE"
 551       include "COMMON.INTERACT"
 552       include "COMMON.IOUNITS"
 553       include "COMMON.VAR"
 554       include "COMMON.GEO"
 555       include "COMMON.CLUSTER"
 556       integer i,j,k,icount,jj_old,jj,Previous,Next
 557       icount=1
 558 #ifdef DEBUG
 559       write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
 560       call flush(iout)
 561 #endif
 562       do while (icount.gt.0)
 563       call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
 564      &     STATUS,IERROR)
 565       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,
 566      &     IERROR)
 567 #ifdef DEBUG
 568       write (iout,*) "Processor",me," icount",icount
 569 #endif
 570       if (icount.eq.0) return
 571       call MPI_Recv(nss_all(1),icount,MPI_INTEGER,
 572      &    Previous,571,MPI_COMM_WORLD,STATUS,IERROR)
 573       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
 574      &  Next,571,MPI_COMM_WORLD,IERROR)
 575       call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,
 576      &    Previous,572,MPI_COMM_WORLD,STATUS,IERROR)
 577       call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
 578      &  Next,572,MPI_COMM_WORLD,IERROR)
 579       call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,
 580      &    Previous,573,MPI_COMM_WORLD,STATUS,IERROR)
 581       call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
 582      &  Next,573,MPI_COMM_WORLD,IERROR)
 583       call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 584      &  Previous,577,MPI_COMM_WORLD,STATUS,IERROR)
 585       call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 586      &  Next,577,MPI_COMM_WORLD,IERROR)
 587       call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 588      &  Previous,579,MPI_COMM_WORLD,STATUS,IERROR)
 589       call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 590      &  Next,579,MPI_COMM_WORLD,IERROR)
 591       call MPI_Recv(allcart(1,1,1),3*icount*maxres2,
 592      &  MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR)
 593       call MPI_Send(allcart(1,1,1),3*icount*maxres2,
 594      &  MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 595       jj=jj_old+icount-1
 596       call dawrite_ccoords(jj_old,jj,icbase)
 597       jj_old=jj+1
 598 #ifdef DEBUG
 599       write (iout,*) "Processor",me," received",icount," conformations"
 600       do i=1,icount
 601         write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
 602         write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
 603         write (iout,'(e15.5,16i5)') entfac(i)
 604       enddo
 605 #endif
 606       enddo
 607       return
 608       end
 609 #endif
 610 c------------------------------------------------------------------------------
 611       subroutine daread_ccoords(istart_conf,iend_conf)
 612       implicit none
 613       include "DIMENSIONS"
 614       include "sizesclu.dat"
 615 #ifdef MPI
 616       include "mpif.h"
 617       include "COMMON.MPI"
 618 #endif
 619       include "COMMON.CHAIN"
 620       include "COMMON.CLUSTER"
 621       include "COMMON.IOUNITS"
 622       include "COMMON.INTERACT"
 623       include "COMMON.VAR"
 624       include "COMMON.SBRIDGE"
 625       include "COMMON.GEO"
 626       integer istart_conf,iend_conf
 627       integer i,j,ij,ii,iii
 628       integer len
 629       character*16 form,acc
 630       character*32 nam
 631 c
 632 c Read conformations off a DA scratchfile.
 633 c
 634 #ifdef DEBUG
 635       write (iout,*) "DAREAD_COORDS"
 636       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
 637       inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
 638       write (iout,*) "len=",len," form=",form," acc=",acc
 639       write (iout,*) "nam=",nam
 640       call flush(iout)
 641 #endif
 642       do ii=istart_conf,iend_conf
 643         ij = ii - istart_conf + 1
 644         iii=list_conf(ii)
 645 #ifdef DEBUG
 646         write (iout,*) "Reading binary file, record",iii," ii",ii
 647         call flush(iout)
 648 #endif
 649         read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
 650      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
 651      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
 652      &    entfac(ii),rmstb(ii)
 653 #ifdef DEBUG
 654         write (iout,*) ii,iii,ij,entfac(ii)
 655         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
 656         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),
 657      &    i=nnt+nres,nct+nres)
 658         write (iout,'(2e15.5)') entfac(ij)
 659         write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
 660      &    jhpb_all(i,ij),i=1,nss)
 661         call flush(iout)
 662 #endif
 663       enddo
 664       return
 665       end
 666 c------------------------------------------------------------------------------
 667       subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out)
 668       implicit none
 669       include "DIMENSIONS"
 670       include "sizesclu.dat"
 671 #ifdef MPI
 672       include "mpif.h"
 673       include "COMMON.MPI"
 674 #endif
 675       include "COMMON.CHAIN"
 676       include "COMMON.INTERACT"
 677       include "COMMON.IOUNITS"
 678       include "COMMON.VAR"
 679       include "COMMON.SBRIDGE"
 680       include "COMMON.GEO"
 681       include "COMMON.CLUSTER"
 682       integer istart_conf,iend_conf
 683       integer i,j,ii,ij,iii,unit_out
 684       integer len
 685       character*16 form,acc
 686       character*32 nam
 687 c
 688 c Write conformations to a DA scratchfile.
 689 c
 690 #ifdef DEBUG
 691       write (iout,*) "DAWRITE_COORDS"
 692       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
 693       write (iout,*) "lenrec",lenrec
 694       inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
 695       write (iout,*) "len=",len," form=",form," acc=",acc
 696       write (iout,*) "nam=",nam
 697       call flush(iout)
 698 #endif
 699       do ii=istart_conf,iend_conf
 700         iii=list_conf(ii)
 701         ij = ii - istart_conf + 1
 702 #ifdef DEBUG
 703         write (iout,*) "Writing binary file, record",iii," ii",ii
 704         call flush(iout)
 705 #endif
 706         write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
 707      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
 708      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
 709      &    entfac(ii),rmstb(ii)
 710 #ifdef DEBUG
 711         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
 712         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
 713      &   nct+nres)
 714         write (iout,'(2e15.5)') entfac(ij)
 715         write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,
 716      &   nss_all(ij))
 717         call flush(iout)
 718 #endif
 719       enddo
 720       return
 721       end