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