multichain wham ignores conf. energies>10E6 and speed up of starts
[unres.git] / 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             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