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