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