1 subroutine read_coords(ncon,*)
7 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
10 include "COMMON.CONTROL"
11 include "COMMON.CHAIN"
12 include "COMMON.INTERACT"
13 include "COMMON.IOUNITS"
15 include "COMMON.SBRIDGE"
17 include "COMMON.CLUSTER"
20 integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,if,ib,
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
28 double precision rjunk
29 integer ntot_all(0:maxprocs-1)
31 double precision energia(0:max_ene),etot
32 real*4 csingle(3,maxres2+2)
34 character*256 bprotfiles
35 c print *,"Processor",me," calls read_protein_data"
37 if (me.eq.master) then
38 Previous=MPI_PROC_NULL
42 if (me.eq.nprocs-1) then
47 c Set the scratchfile names
48 write (liczba,'(bz,i3.3)') me
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
55 write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss", nss
56 write (iout,*) "lenrec_in",lenrec_in
58 bprotfiles=scratchdir(:ilen(scratchdir))//
59 & "/"//prefix(:ilen(prefix))//liczba//".xbin"
64 if (from_cart .and. .not. from_bx .and. .not. from_cx) then
66 read (intin,*,end=13,err=11) energy(icon),totfree(icon),
68 & nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon),
69 & i=1,nss_all(icon)),iscore(icon)
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)
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)
80 read(intin,'(a80)',end=13,err=12) lineh
81 read(lineh(:5),*,err=8) ic
83 read(lineh(6:),*,err=8) energy(icon)
85 read(lineh(6:),*,err=8) energy(icon)
89 print *,'error, assuming e=1d10',lineh
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)),
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)
109 PRINT *,'IC:',IC,' ENERGY:',ENERGY(ICON)
110 call read_angles(intin,*13)
112 phiall(i,icon)=phi(i)
113 thetall(i,icon)=theta(i)
114 alphall(i,icon)=alph(i)
115 omall(i,icon)=omeg(i)
121 C CALCULATE DISTANCES
123 10 print *,'something wrong with angles'
125 11 print *,'something wrong with NSS',nss
127 12 print *,'something wrong with header'
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.
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
151 open (intin,file=intinname,status="old",form="unformatted",
152 & access="direct",recl=lenrec_in)
154 else if (from_cx) then
155 #if (defined(AIX) && !defined(JUBL))
156 call xdrfopen_(ixdrf,intinname, "r", iret)
158 call xdrfopen(ixdrf,intinname, "r", iret)
161 write (iout,*) "xdrfopen: iret",iret
163 write (iout,*) "Error: coordinate file ",
164 & intinname(:ilen(intinname))," does not exist."
167 call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE)
172 write (iout,*) "Error: coordinate format not specified"
175 call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE)
183 write (iout,*) "Opening file ",intinname(:ilen(intinname))
184 write (iout,*) "lenrec",lenrec_in
188 c write (iout,*) "maxconf",maxconf
192 if (i.gt.maxconf) then
193 write (iout,*) "Error: too many conformations ",
194 & "(",maxconf,") maximum."
196 call MPI_Abort(MPI_COMM_WORLD,errcode,ierror)
200 c write (iout,*) "i",i
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),
208 & entfac(jj+1),rmstb(jj+1),iscor
215 #if (defined(AIX) && !defined(JUBL))
216 call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret)
217 if (iret.eq.0) goto 101
218 call xdrfint_(ixdrf, nss, iret)
219 if (iret.eq.0) goto 101
221 call xdrfint_(ixdrf, ihpb(j), iret)
222 if (iret.eq.0) goto 101
223 call xdrfint_(ixdrf, jhpb(j), iret)
224 if (iret.eq.0) goto 101
226 call xdrffloat_(ixdrf,reini,iret)
227 if (iret.eq.0) goto 101
228 call xdrffloat_(ixdrf,refree,iret)
229 if (iret.eq.0) goto 101
230 call xdrffloat_(ixdrf,rmsdev,iret)
231 if (iret.eq.0) goto 101
232 call xdrfint_(ixdrf,iscor,iret)
233 if (iret.eq.0) goto 101
235 c write (iout,*) "calling xdrf3dfcoord"
236 call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret)
237 c write (iout,*) "iret",iret
239 if (iret.eq.0) goto 101
240 call xdrfint(ixdrf, nss, iret)
241 c write (iout,*) "iret",iret
242 c write (iout,*) "nss",nss
244 if (iret.eq.0) goto 101
246 call xdrfint(ixdrf, ihpb(k), iret)
247 if (iret.eq.0) goto 101
248 call xdrfint(ixdrf, jhpb(k), iret)
249 if (iret.eq.0) goto 101
251 call xdrffloat(ixdrf,reini,iret)
252 if (iret.eq.0) goto 101
253 call xdrffloat(ixdrf,refree,iret)
254 if (iret.eq.0) goto 101
255 call xdrffloat(ixdrf,rmsdev,iret)
256 if (iret.eq.0) goto 101
257 call xdrfint(ixdrf,iscor,iret)
258 if (iret.eq.0) goto 101
270 c(l,nres+k)=csingle(l,nres+k-nnt+1)
275 write (iout,'(5hREAD ,i5,3f15.4,i10)')
276 & jj+1,energy(jj+1),entfac(jj+1),
278 write (iout,*) "Conformation",jjj+1,jj+1
279 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
280 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
283 call add_new_cconf(jjj,jj,jj_old,icount,Next)
286 write (iout,*) i-1," conformations read from DA file ",
287 & intinname(:ilen(intinname))
288 write (iout,*) jj," conformations read so far"
292 #if (defined(AIX) && !defined(JUBL))
293 call xdrfclose_(ixdrf, iret)
295 call xdrfclose(ixdrf, iret)
300 write (iout,*) "jj_old",jj_old," jj",jj
302 call write_and_send_cconf(icount,jj_old,jj,Next)
303 call MPI_Send(0,1,MPI_INTEGER,Next,570,
304 & MPI_COMM_WORLD,IERROR)
307 call write_and_send_cconf(icount,jj_old,jj,Next)
309 t_acq = tcpu() - t_acq
311 write (iout,*) "Processor",me,
312 & " time for conformation read/send",t_acq
314 c A worker gets the confs from the master and sends them to its neighbor
316 call receive_and_pass_cconf(icount,jj_old,jj,
318 t_acq = tcpu() - t_acq
325 write(iout,*)"A total of",ncon," conformations read."
328 c Check if everyone has the same number of conformations
329 call MPI_Allgather(ncon,1,MPI_INTEGER,
330 & ntot_all(0),1,MPI_INTEGER,MPI_Comm_World,IERROR)
334 if (ncon.ne.ntot_all(i)) then
335 write (iout,*) "Number of conformations at processor",i,
336 & " differs from that at processor",me,
344 write (iout,*) "Number of conformations read by processors"
347 write (iout,'(8i10)') i,ntot_all(i)
349 write (iout,*) "Calculation terminated."
355 1111 write(iout,*) "Error opening coordinate file ",
356 & intinname(:ilen(intinname))
360 c------------------------------------------------------------------------------
361 subroutine add_new_cconf(jjj,jj,jj_old,icount,Next)
364 include "sizesclu.dat"
365 include "COMMON.CLUSTER"
366 include "COMMON.CHAIN"
367 include "COMMON.INTERACT"
368 include "COMMON.LOCAL"
369 include "COMMON.IOUNITS"
370 include "COMMON.NAMES"
372 include "COMMON.SBRIDGE"
374 integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib
375 & nn,nn1,inan,Next,itj
376 double precision etot,energia(0:max_ene)
378 call int_from_cart1(.false.)
380 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
381 write (iout,*) "Conformation",jjj,jj+1
382 write (iout,*) "Bad CA-CA bond length",j," ",vbld(j)
383 write (iout,*) "The Cartesian geometry is:"
384 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
385 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
386 write (iout,*) "The internal geometry is:"
387 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
388 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
389 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
390 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
391 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
392 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
394 & "This conformation WILL NOT be added to the database."
400 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0)
402 write (iout,*) "Conformation",jjj,jj+1
403 write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
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)
415 & "This conformation WILL NOT be added to the database."
420 if (theta(j).le.0.0d0) then
422 & "Zero theta angle(s) in conformation",jjj,jj+1
423 write (iout,*) "The Cartesian geometry is:"
424 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
425 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
426 write (iout,*) "The internal geometry is:"
427 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
428 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
429 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
430 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
431 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
432 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
434 & "This conformation WILL NOT be added to the database."
437 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
441 write (iout,*) "Conformation",jjj,jj
442 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
443 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
444 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
445 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
446 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
447 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
448 write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
449 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
450 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
451 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
452 write (iout,'(e15.5,16i5)') entfac(icount+1),
456 call store_cconf_from_file(jj,icount)
457 if (icount.eq.maxstr_proc) then
459 write (iout,* ) "jj_old",jj_old," jj",jj
461 call write_and_send_cconf(icount,jj_old,jj,Next)
467 c------------------------------------------------------------------------------
468 subroutine store_cconf_from_file(jj,icount)
471 include "sizesclu.dat"
472 include "COMMON.CLUSTER"
473 include "COMMON.CHAIN"
474 include "COMMON.SBRIDGE"
475 include "COMMON.INTERACT"
476 include "COMMON.IOUNITS"
478 integer i,j,jj,icount
479 c Store the conformation that has been read in
482 allcart(j,i,icount)=c(j,i)
487 ihpb_all(i,icount)=ihpb(i)
488 jhpb_all(i,icount)=jhpb(i)
492 c------------------------------------------------------------------------------
493 subroutine write_and_send_cconf(icount,jj_old,jj,Next)
496 include "sizesclu.dat"
502 include "COMMON.CHAIN"
503 include "COMMON.SBRIDGE"
504 include "COMMON.INTERACT"
505 include "COMMON.IOUNITS"
506 include "COMMON.CLUSTER"
508 integer icount,jj_old,jj,Next
509 c Write the structures to a scratch file
511 c Master sends the portion of conformations that have been read in to the neighbor
513 write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
516 call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
517 call MPI_Send(nss_all(1),icount,MPI_INTEGER,
518 & Next,571,MPI_COMM_WORLD,IERROR)
519 call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
520 & Next,572,MPI_COMM_WORLD,IERROR)
521 call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
522 & Next,573,MPI_COMM_WORLD,IERROR)
523 call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
524 & Next,577,MPI_COMM_WORLD,IERROR)
525 call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
526 & Next,579,MPI_COMM_WORLD,IERROR)
527 call MPI_Send(allcart(1,1,1),3*icount*maxres2,
528 & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
530 call dawrite_ccoords(jj_old,jj,icbase)
533 c------------------------------------------------------------------------------
535 subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,
539 include "sizesclu.dat"
541 integer IERROR,STATUS(MPI_STATUS_SIZE)
543 include "COMMON.CHAIN"
544 include "COMMON.SBRIDGE"
545 include "COMMON.INTERACT"
546 include "COMMON.IOUNITS"
549 include "COMMON.CLUSTER"
550 integer i,j,k,icount,jj_old,jj,Previous,Next
553 write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
556 do while (icount.gt.0)
557 call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
559 call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,
562 write (iout,*) "Processor",me," icount",icount
564 if (icount.eq.0) return
565 call MPI_Recv(nss_all(1),icount,MPI_INTEGER,
566 & Previous,571,MPI_COMM_WORLD,STATUS,IERROR)
567 call MPI_Send(nss_all(1),icount,MPI_INTEGER,
568 & Next,571,MPI_COMM_WORLD,IERROR)
569 call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,
570 & Previous,572,MPI_COMM_WORLD,STATUS,IERROR)
571 call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
572 & Next,572,MPI_COMM_WORLD,IERROR)
573 call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,
574 & Previous,573,MPI_COMM_WORLD,STATUS,IERROR)
575 call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
576 & Next,573,MPI_COMM_WORLD,IERROR)
577 call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
578 & Previous,577,MPI_COMM_WORLD,STATUS,IERROR)
579 call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
580 & Next,577,MPI_COMM_WORLD,IERROR)
581 call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
582 & Previous,579,MPI_COMM_WORLD,STATUS,IERROR)
583 call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
584 & Next,579,MPI_COMM_WORLD,IERROR)
585 call MPI_Recv(allcart(1,1,1),3*icount*maxres2,
586 & MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR)
587 call MPI_Send(allcart(1,1,1),3*icount*maxres2,
588 & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
590 call dawrite_ccoords(jj_old,jj,icbase)
593 write (iout,*) "Processor",me," received",icount," conformations"
595 write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
596 write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
597 write (iout,'(e15.5,16i5)') entfac(i)
604 c------------------------------------------------------------------------------
605 subroutine daread_ccoords(istart_conf,iend_conf)
608 include "sizesclu.dat"
613 include "COMMON.CHAIN"
614 include "COMMON.CLUSTER"
615 include "COMMON.IOUNITS"
616 include "COMMON.INTERACT"
618 include "COMMON.SBRIDGE"
620 integer istart_conf,iend_conf
621 integer i,j,ij,ii,iii
623 character*16 form,acc
626 c Read conformations off a DA scratchfile.
629 write (iout,*) "DAREAD_COORDS"
630 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
631 inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
632 write (iout,*) "len=",len," form=",form," acc=",acc
633 write (iout,*) "nam=",nam
636 do ii=istart_conf,iend_conf
637 ij = ii - istart_conf + 1
640 write (iout,*) "Reading binary file, record",iii," ii",ii
643 read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
644 & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
645 & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
646 & entfac(ii),rmstb(ii)
648 write (iout,*) ii,iii,ij,entfac(ii)
649 write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
650 write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),
651 & i=nnt+nres,nct+nres)
652 write (iout,'(2e15.5)') entfac(ij)
653 write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
654 & jhpb_all(i,ij),i=1,nss)
660 c------------------------------------------------------------------------------
661 subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out)
664 include "sizesclu.dat"
669 include "COMMON.CHAIN"
670 include "COMMON.INTERACT"
671 include "COMMON.IOUNITS"
673 include "COMMON.SBRIDGE"
675 include "COMMON.CLUSTER"
676 integer istart_conf,iend_conf
677 integer i,j,ii,ij,iii,unit_out
679 character*16 form,acc
682 c Write conformations to a DA scratchfile.
685 write (iout,*) "DAWRITE_COORDS"
686 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
687 write (iout,*) "lenrec",lenrec
688 inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
689 write (iout,*) "len=",len," form=",form," acc=",acc
690 write (iout,*) "nam=",nam
693 do ii=istart_conf,iend_conf
695 ij = ii - istart_conf + 1
697 write (iout,*) "Writing binary file, record",iii," ii",ii
700 write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
701 & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
702 & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
703 & entfac(ii),rmstb(ii)
705 write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
706 write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
708 write (iout,'(2e15.5)') entfac(ij)
709 write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,