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