rm uscdiff
[unres.git] / source / cluster / wham / src-M / 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       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