36e80e60ada56de470286291dc4dea1e2c5bb2c4
[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 #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