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