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