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