source/cluster/wham/src-M/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             itmp=0
 216 #if (defined(AIX) && !defined(JUBL))
 217             call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret)
 218             if (iret.eq.0) goto 101
 219             call xdrfint_(ixdrf, nss, iret)
 220             if (iret.eq.0) goto 101
 221             do j=1,nss
 222               call xdrfint_(ixdrf, ihpb(j), iret)
 223               if (iret.eq.0) goto 101
 224               call xdrfint_(ixdrf, jhpb(j), iret)
 225               if (iret.eq.0) goto 101
 226             enddo
 227             call xdrffloat_(ixdrf,reini,iret)
 228             if (iret.eq.0) goto 101
 229             call xdrffloat_(ixdrf,refree,iret)
 230             if (iret.eq.0) goto 101
 231             call xdrffloat_(ixdrf,rmsdev,iret)
 232             if (iret.eq.0) goto 101
 233             call xdrfint_(ixdrf,iscor,iret)
 234             if (iret.eq.0) goto 101
 235 #else
 236 c            write (iout,*) "calling xdrf3dfcoord"
 237             call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret)
 238 c            write (iout,*) "iret",iret
 239 c            call flush(iout)
 240             if (iret.eq.0) goto 101
 241             call xdrfint(ixdrf, nss, iret)
 242 c            write (iout,*) "iret",iret
 243 c            write (iout,*) "nss",nss
 244             call flush(iout)
 245             if (iret.eq.0) goto 101
 246             do k=1,nss
 247               call xdrfint(ixdrf, ihpb(k), iret)
 248               if (iret.eq.0) goto 101
 249               call xdrfint(ixdrf, jhpb(k), iret)
 250               if (iret.eq.0) goto 101
 251             enddo
 252             call xdrffloat(ixdrf,reini,iret)
 253             if (iret.eq.0) goto 101
 254             call xdrffloat(ixdrf,refree,iret)
 255             if (iret.eq.0) goto 101
 256             call xdrffloat(ixdrf,rmsdev,iret)
 257             if (iret.eq.0) goto 101
 258             call xdrfint(ixdrf,iscor,iret)
 259             if (iret.eq.0) goto 101
 260 #endif
 261             energy(jj+1)=reini
 262             entfac(jj+1)=refree
 263             rmstb(jj+1)=rmsdev
 264             do k=1,nres
 265               do l=1,3
 266                 c(l,k)=csingle(l,k)
 267               enddo
 268             enddo
 269             do k=nnt,nct
 270               do l=1,3
 271                 c(l,nres+k)=csingle(l,nres+k-nnt+1)
 272               enddo
 273             enddo
 274           endif
 275 #ifdef DEBUG
 276           write (iout,'(5hREAD ,i5,3f15.4,i10)')
 277      &     jj+1,energy(jj+1),entfac(jj+1),
 278      &     rmstb(jj+1),iscor
 279           write (iout,*) "Conformation",jjj+1,jj+1
 280           write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
 281           write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
 282           call flush(iout)
 283 #endif
 284           call add_new_cconf(jjj,jj,jj_old,icount,Next)
 285         enddo
 286   101   continue
 287         write (iout,*) i-1," conformations read from DA file ",
 288      &    intinname(:ilen(intinname))
 289         write (iout,*) jj," conformations read so far"
 290         if (from_bx) then
 291           close(intin)
 292         else
 293 #if (defined(AIX) && !defined(JUBL))
 294           call xdrfclose_(ixdrf, iret)
 295 #else
 296           call xdrfclose(ixdrf, iret)
 297 #endif
 298         endif
 299 #ifdef MPI
 300 c#ifdef DEBUG
 301         write (iout,*) "jj_old",jj_old," jj",jj
 302 c#endif
 303         call write_and_send_cconf(icount,jj_old,jj,Next)
 304         call MPI_Send(0,1,MPI_INTEGER,Next,570,
 305      &             MPI_COMM_WORLD,IERROR)
 306         jj_old=jj+1
 307 #else
 308         call write_and_send_cconf(icount,jj_old,jj,Next)
 309 #endif
 310         t_acq = tcpu() - t_acq
 311 #ifdef MPI
 312         write (iout,*) "Processor",me,
 313      &    " time for conformation read/send",t_acq
 314       ELSE
 315 c A worker gets the confs from the master and sends them to its neighbor
 316         t_acq = tcpu()
 317         call receive_and_pass_cconf(icount,jj_old,jj,
 318      &    Previous,Next)
 319         t_acq = tcpu() - t_acq
 320       ENDIF
 321 #endif
 322       ncon=jj
 323 c      close(icbase)
 324       close(intin)
 325
 326       write(iout,*)"A total of",ncon," conformations read."
 327
 328 #ifdef MPI
 329 c Check if everyone has the same number of conformations
 330       call MPI_Allgather(ncon,1,MPI_INTEGER,
 331      &  ntot_all(0),1,MPI_INTEGER,MPI_Comm_World,IERROR)
 332       lerr=.false.
 333       do i=0,nprocs-1
 334         if (i.ne.me) then
 335             if (ncon.ne.ntot_all(i)) then
 336               write (iout,*) "Number of conformations at processor",i,
 337      &         " differs from that at processor",me,
 338      &         ncon,ntot_all(i)
 339               lerr = .true.
 340             endif
 341         endif
 342       enddo
 343       if (lerr) then
 344         write (iout,*)
 345         write (iout,*) "Number of conformations read by processors"
 346         write (iout,*)
 347         do i=0,nprocs-1
 348           write (iout,'(8i10)') i,ntot_all(i)
 349         enddo
 350         write (iout,*) "Calculation terminated."
 351         call flush(iout)
 352         return1
 353       endif
 354       return
 355 #endif
 356  1111 write(iout,*) "Error opening coordinate file ",
 357      & intinname(:ilen(intinname))
 358       call flush(iout)
 359       return1
 360       end
 361 c------------------------------------------------------------------------------
 362       subroutine add_new_cconf(jjj,jj,jj_old,icount,Next)
 363       implicit none
 364       include "DIMENSIONS"
 365       include "sizesclu.dat"
 366       include "COMMON.CLUSTER"
 367       include "COMMON.CONTROL"
 368       include "COMMON.CHAIN"
 369       include "COMMON.INTERACT"
 370       include "COMMON.LOCAL"
 371       include "COMMON.IOUNITS"
 372       include "COMMON.NAMES"
 373       include "COMMON.VAR"
 374       include "COMMON.SBRIDGE"
 375       include "COMMON.GEO"
 376       integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib
 377      &  nn,nn1,inan,Next,itj,chalen
 378       double precision etot,energia(0:max_ene)
 379       jjj=jjj+1
 380       chalen=int((nct-nnt+2)/symetr)
 381       call int_from_cart1(.false.)
 382       do j=nnt+1,nct
 383         if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
 384          if (j.gt.2) then
 385           if (itel(j).ne.0 .and. itel(j-1).ne.0) then
 386           write (iout,*) "Conformation",jjj,jj+1
 387           write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j),
 388      & chalen
 389           write (iout,*) "The Cartesian geometry is:"
 390           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 391           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 392           write (iout,*) "The internal geometry is:"
 393           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 394           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 395           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 396           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 397           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 398           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 399           write (iout,*)
 400      &      "This conformation WILL NOT be added to the database."
 401           return
 402           endif
 403          endif
 404         endif
 405       enddo
 406       do j=nnt,nct
 407         itj=itype(j)
 408         if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
 409           write (iout,*) "Conformation",jjj,jj+1
 410           write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
 411           write (iout,*) "The Cartesian geometry is:"
 412           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 413           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 414           write (iout,*) "The internal geometry is:"
 415           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 416           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 417           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 418           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 419           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 420           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 421           write (iout,*)
 422      &      "This conformation WILL NOT be added to the database."
 423           return
 424         endif
 425       enddo
 426       do j=3,nres
 427         if (theta(j).le.0.0d0) then
 428           write (iout,*)
 429      &      "Zero theta angle(s) in conformation",jjj,jj+1
 430           write (iout,*) "The Cartesian geometry is:"
 431           write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
 432           write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
 433           write (iout,*) "The internal geometry is:"
 434           write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 435           write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 436           write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 437           write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 438           write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 439           write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 440           write (iout,*)
 441      &      "This conformation WILL NOT be added to the database."
 442           return
 443         endif
 444         if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
 445       enddo
 446       jj=jj+1
 447 #ifdef DEBUG
 448       write (iout,*) "Conformation",jjj,jj
 449       write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
 450       write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
 451       write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
 452       write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
 453       write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
 454       write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
 455       write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
 456       write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
 457       write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
 458       write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
 459       write (iout,'(e15.5,16i5)') entfac(icount+1)
 460 c     &        iscore(icount+1,0)
 461 #endif
 462       icount=icount+1
 463       call store_cconf_from_file(jj,icount)
 464       if (icount.eq.maxstr_proc) then
 465 #ifdef DEBUG
 466         write (iout,* ) "jj_old",jj_old," jj",jj
 467 #endif
 468         call write_and_send_cconf(icount,jj_old,jj,Next)
 469         jj_old=jj+1
 470         icount=0
 471       endif
 472       return
 473       end
 474 c------------------------------------------------------------------------------
 475       subroutine store_cconf_from_file(jj,icount)
 476       implicit none
 477       include "DIMENSIONS"
 478       include "sizesclu.dat"
 479       include "COMMON.CLUSTER"
 480       include "COMMON.CHAIN"
 481       include "COMMON.SBRIDGE"
 482       include "COMMON.INTERACT"
 483       include "COMMON.IOUNITS"
 484       include "COMMON.VAR"
 485       integer i,j,jj,icount
 486 c Store the conformation that has been read in
 487       do i=1,2*nres
 488         do j=1,3
 489           allcart(j,i,icount)=c(j,i)
 490         enddo
 491       enddo
 492       nss_all(icount)=nss
 493       do i=1,nss
 494         ihpb_all(i,icount)=ihpb(i)
 495         jhpb_all(i,icount)=jhpb(i)
 496       enddo
 497       return
 498       end
 499 c------------------------------------------------------------------------------
 500       subroutine write_and_send_cconf(icount,jj_old,jj,Next)
 501       implicit none
 502       include "DIMENSIONS"
 503       include "sizesclu.dat"
 504 #ifdef MPI
 505       include "mpif.h"
 506       integer IERROR
 507       include "COMMON.MPI"
 508 #endif
 509       include "COMMON.CHAIN"
 510       include "COMMON.SBRIDGE"
 511       include "COMMON.INTERACT"
 512       include "COMMON.IOUNITS"
 513       include "COMMON.CLUSTER"
 514       include "COMMON.VAR"
 515       integer icount,jj_old,jj,Next
 516 c Write the structures to a scratch file
 517 #ifdef MPI
 518 c Master sends the portion of conformations that have been read in to the neighbor
 519 #ifdef DEBUG
 520       write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
 521       call flush(iout)
 522 #endif
 523       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
 524       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
 525      &    Next,571,MPI_COMM_WORLD,IERROR)
 526       call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
 527      &    Next,572,MPI_COMM_WORLD,IERROR)
 528       call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
 529      &    Next,573,MPI_COMM_WORLD,IERROR)
 530       call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 531      &    Next,577,MPI_COMM_WORLD,IERROR)
 532       call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 533      &    Next,579,MPI_COMM_WORLD,IERROR)
 534       call MPI_Send(allcart(1,1,1),3*icount*maxres2,
 535      &    MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 536 #endif
 537       call dawrite_ccoords(jj_old,jj,icbase)
 538       return
 539       end
 540 c------------------------------------------------------------------------------
 541 #ifdef MPI
 542       subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,
 543      &  Next)
 544       implicit none
 545       include "DIMENSIONS"
 546       include "sizesclu.dat"
 547       include "mpif.h"
 548       integer IERROR,STATUS(MPI_STATUS_SIZE)
 549       include "COMMON.MPI"
 550       include "COMMON.CHAIN"
 551       include "COMMON.SBRIDGE"
 552       include "COMMON.INTERACT"
 553       include "COMMON.IOUNITS"
 554       include "COMMON.VAR"
 555       include "COMMON.GEO"
 556       include "COMMON.CLUSTER"
 557       integer i,j,k,icount,jj_old,jj,Previous,Next
 558       icount=1
 559 #ifdef DEBUG
 560       write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
 561       call flush(iout)
 562 #endif
 563       do while (icount.gt.0)
 564       call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
 565      &     STATUS,IERROR)
 566       call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,
 567      &     IERROR)
 568 #ifdef DEBUG
 569       write (iout,*) "Processor",me," icount",icount
 570 #endif
 571       if (icount.eq.0) return
 572       call MPI_Recv(nss_all(1),icount,MPI_INTEGER,
 573      &    Previous,571,MPI_COMM_WORLD,STATUS,IERROR)
 574       call MPI_Send(nss_all(1),icount,MPI_INTEGER,
 575      &  Next,571,MPI_COMM_WORLD,IERROR)
 576       call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,
 577      &    Previous,572,MPI_COMM_WORLD,STATUS,IERROR)
 578       call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
 579      &  Next,572,MPI_COMM_WORLD,IERROR)
 580       call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,
 581      &    Previous,573,MPI_COMM_WORLD,STATUS,IERROR)
 582       call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
 583      &  Next,573,MPI_COMM_WORLD,IERROR)
 584       call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 585      &  Previous,577,MPI_COMM_WORLD,STATUS,IERROR)
 586       call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
 587      &  Next,577,MPI_COMM_WORLD,IERROR)
 588       call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 589      &  Previous,579,MPI_COMM_WORLD,STATUS,IERROR)
 590       call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
 591      &  Next,579,MPI_COMM_WORLD,IERROR)
 592       call MPI_Recv(allcart(1,1,1),3*icount*maxres2,
 593      &  MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR)
 594       call MPI_Send(allcart(1,1,1),3*icount*maxres2,
 595      &  MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
 596       jj=jj_old+icount-1
 597       call dawrite_ccoords(jj_old,jj,icbase)
 598       jj_old=jj+1
 599 #ifdef DEBUG
 600       write (iout,*) "Processor",me," received",icount," conformations"
 601       do i=1,icount
 602         write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
 603         write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
 604         write (iout,'(e15.5,16i5)') entfac(i)
 605       enddo
 606 #endif
 607       enddo
 608       return
 609       end
 610 #endif
 611 c------------------------------------------------------------------------------
 612       subroutine daread_ccoords(istart_conf,iend_conf)
 613       implicit none
 614       include "DIMENSIONS"
 615       include "sizesclu.dat"
 616 #ifdef MPI
 617       include "mpif.h"
 618       include "COMMON.MPI"
 619 #endif
 620       include "COMMON.CHAIN"
 621       include "COMMON.CLUSTER"
 622       include "COMMON.IOUNITS"
 623       include "COMMON.INTERACT"
 624       include "COMMON.VAR"
 625       include "COMMON.SBRIDGE"
 626       include "COMMON.GEO"
 627       integer istart_conf,iend_conf
 628       integer i,j,ij,ii,iii
 629       integer len
 630       character*16 form,acc
 631       character*32 nam
 632 c
 633 c Read conformations off a DA scratchfile.
 634 c
 635 #ifdef DEBUG
 636       write (iout,*) "DAREAD_COORDS"
 637       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
 638       inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
 639       write (iout,*) "len=",len," form=",form," acc=",acc
 640       write (iout,*) "nam=",nam
 641       call flush(iout)
 642 #endif
 643       do ii=istart_conf,iend_conf
 644         ij = ii - istart_conf + 1
 645         iii=list_conf(ii)
 646 #ifdef DEBUG
 647         write (iout,*) "Reading binary file, record",iii," ii",ii
 648         call flush(iout)
 649 #endif
 650         read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
 651      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
 652      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
 653      &    entfac(ii),rmstb(ii)
 654 #ifdef DEBUG
 655         write (iout,*) ii,iii,ij,entfac(ii)
 656         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
 657         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),
 658      &    i=nnt+nres,nct+nres)
 659         write (iout,'(2e15.5)') entfac(ij)
 660         write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
 661      &    jhpb_all(i,ij),i=1,nss)
 662         call flush(iout)
 663 #endif
 664       enddo
 665       return
 666       end
 667 c------------------------------------------------------------------------------
 668       subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out)
 669       implicit none
 670       include "DIMENSIONS"
 671       include "sizesclu.dat"
 672 #ifdef MPI
 673       include "mpif.h"
 674       include "COMMON.MPI"
 675 #endif
 676       include "COMMON.CHAIN"
 677       include "COMMON.INTERACT"
 678       include "COMMON.IOUNITS"
 679       include "COMMON.VAR"
 680       include "COMMON.SBRIDGE"
 681       include "COMMON.GEO"
 682       include "COMMON.CLUSTER"
 683       integer istart_conf,iend_conf
 684       integer i,j,ii,ij,iii,unit_out
 685       integer len
 686       character*16 form,acc
 687       character*32 nam
 688 c
 689 c Write conformations to a DA scratchfile.
 690 c
 691 #ifdef DEBUG
 692       write (iout,*) "DAWRITE_COORDS"
 693       write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
 694       write (iout,*) "lenrec",lenrec
 695       inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
 696       write (iout,*) "len=",len," form=",form," acc=",acc
 697       write (iout,*) "nam=",nam
 698       call flush(iout)
 699 #endif
 700       do ii=istart_conf,iend_conf
 701         iii=list_conf(ii)
 702         ij = ii - istart_conf + 1
 703 #ifdef DEBUG
 704         write (iout,*) "Writing binary file, record",iii," ii",ii
 705         call flush(iout)
 706 #endif
 707         write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
 708      &    ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
 709      &    nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
 710      &    entfac(ii),rmstb(ii)
 711 #ifdef DEBUG
 712         write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
 713         write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
 714      &   nct+nres)
 715         write (iout,'(2e15.5)') entfac(ij)
 716         write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,
 717      &   nss_all(ij))
 718         call flush(iout)
 719 #endif
 720       enddo
 721       return
 722       end