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
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
222 call xdrfint_(ixdrf, ihpb(j), iret)
223 if (iret.eq.0) goto 101
224 call xdrfint_(ixdrf, jhpb(j), iret)
225 if (iret.eq.0) goto 101
227 call xdrffloat_(ixdrf,reini,iret)
228 if (iret.eq.0) goto 101
229 call xdrffloat_(ixdrf,refree,iret)
230 if (iret.eq.0) goto 101
231 call xdrffloat_(ixdrf,rmsdev,iret)
232 if (iret.eq.0) goto 101
233 call xdrfint_(ixdrf,iscor,iret)
234 if (iret.eq.0) goto 101
236 c write (iout,*) "calling xdrf3dfcoord"
237 call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret)
238 c write (iout,*) "iret",iret
240 if (iret.eq.0) goto 101
241 call xdrfint(ixdrf, nss, iret)
242 c write (iout,*) "iret",iret
243 c write (iout,*) "nss",nss
245 if (iret.eq.0) goto 101
247 call xdrfint(ixdrf, ihpb(k), iret)
248 if (iret.eq.0) goto 101
249 call xdrfint(ixdrf, jhpb(k), iret)
250 if (iret.eq.0) goto 101
252 call xdrffloat(ixdrf,reini,iret)
253 if (iret.eq.0) goto 101
254 call xdrffloat(ixdrf,refree,iret)
255 if (iret.eq.0) goto 101
256 call xdrffloat(ixdrf,rmsdev,iret)
257 if (iret.eq.0) goto 101
258 call xdrfint(ixdrf,iscor,iret)
259 if (iret.eq.0) goto 101
271 c(l,nres+k)=csingle(l,nres+k-nnt+1)
276 write (iout,'(5hREAD ,i5,3f15.4,i10)')
277 & jj+1,energy(jj+1),entfac(jj+1),
279 write (iout,*) "Conformation",jjj+1,jj+1
280 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
281 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
284 call add_new_cconf(jjj,jj,jj_old,icount,Next)
287 write (iout,*) i-1," conformations read from DA file ",
288 & intinname(:ilen(intinname))
289 write (iout,*) jj," conformations read so far"
293 #if (defined(AIX) && !defined(JUBL))
294 call xdrfclose_(ixdrf, iret)
296 call xdrfclose(ixdrf, iret)
301 write (iout,*) "jj_old",jj_old," jj",jj
303 call write_and_send_cconf(icount,jj_old,jj,Next)
304 call MPI_Send(0,1,MPI_INTEGER,Next,570,
305 & MPI_COMM_WORLD,IERROR)
308 call write_and_send_cconf(icount,jj_old,jj,Next)
310 t_acq = tcpu() - t_acq
312 write (iout,*) "Processor",me,
313 & " time for conformation read/send",t_acq
315 c A worker gets the confs from the master and sends them to its neighbor
317 call receive_and_pass_cconf(icount,jj_old,jj,
319 t_acq = tcpu() - t_acq
326 write(iout,*)"A total of",ncon," conformations read."
329 c Check if everyone has the same number of conformations
330 call MPI_Allgather(ncon,1,MPI_INTEGER,
331 & ntot_all(0),1,MPI_INTEGER,MPI_Comm_World,IERROR)
335 if (ncon.ne.ntot_all(i)) then
336 write (iout,*) "Number of conformations at processor",i,
337 & " differs from that at processor",me,
345 write (iout,*) "Number of conformations read by processors"
348 write (iout,'(8i10)') i,ntot_all(i)
350 write (iout,*) "Calculation terminated."
356 1111 write(iout,*) "Error opening coordinate file ",
357 & intinname(:ilen(intinname))
361 c------------------------------------------------------------------------------
362 subroutine add_new_cconf(jjj,jj,jj_old,icount,Next)
365 include "sizesclu.dat"
366 include "COMMON.CLUSTER"
367 include "COMMON.CONTROL"
368 include "COMMON.CHAIN"
369 include "COMMON.INTERACT"
370 include "COMMON.LOCAL"
371 include "COMMON.IOUNITS"
372 include "COMMON.NAMES"
374 include "COMMON.SBRIDGE"
376 integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib
377 & nn,nn1,inan,Next,itj,chalen
378 double precision etot,energia(0:max_ene)
380 chalen=int((nct-nnt+2)/symetr)
381 call int_from_cart1(.false.)
383 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
385 if (itel(j).ne.0 .and. itel(j-1).ne.0) then
386 write (iout,*) "Conformation",jjj,jj+1
387 write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j),
389 write (iout,*) "The Cartesian geometry is:"
390 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
391 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
392 write (iout,*) "The internal geometry is:"
393 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
394 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
395 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
396 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
397 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
398 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
400 & "This conformation WILL NOT be added to the database."
408 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
409 write (iout,*) "Conformation",jjj,jj+1
410 write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
411 write (iout,*) "The Cartesian geometry is:"
412 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
413 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
414 write (iout,*) "The internal geometry is:"
415 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
416 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
417 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
418 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
419 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
420 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
422 & "This conformation WILL NOT be added to the database."
427 if (theta(j).le.0.0d0) then
429 & "Zero theta angle(s) in conformation",jjj,jj+1
430 write (iout,*) "The Cartesian geometry is:"
431 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
432 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
433 write (iout,*) "The internal geometry is:"
434 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
435 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
436 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
437 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
438 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
439 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
441 & "This conformation WILL NOT be added to the database."
444 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
448 write (iout,*) "Conformation",jjj,jj
449 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
450 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
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)') (vbld(k+nres),k=nnt,nct)
456 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
457 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
458 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
459 write (iout,'(e15.5,16i5)') entfac(icount+1)
460 c & iscore(icount+1,0)
463 call store_cconf_from_file(jj,icount)
464 if (icount.eq.maxstr_proc) then
466 write (iout,* ) "jj_old",jj_old," jj",jj
468 call write_and_send_cconf(icount,jj_old,jj,Next)
474 c------------------------------------------------------------------------------
475 subroutine store_cconf_from_file(jj,icount)
478 include "sizesclu.dat"
479 include "COMMON.CLUSTER"
480 include "COMMON.CHAIN"
481 include "COMMON.SBRIDGE"
482 include "COMMON.INTERACT"
483 include "COMMON.IOUNITS"
485 integer i,j,jj,icount
486 c Store the conformation that has been read in
489 allcart(j,i,icount)=c(j,i)
494 ihpb_all(i,icount)=ihpb(i)
495 jhpb_all(i,icount)=jhpb(i)
499 c------------------------------------------------------------------------------
500 subroutine write_and_send_cconf(icount,jj_old,jj,Next)
503 include "sizesclu.dat"
509 include "COMMON.CHAIN"
510 include "COMMON.SBRIDGE"
511 include "COMMON.INTERACT"
512 include "COMMON.IOUNITS"
513 include "COMMON.CLUSTER"
515 integer icount,jj_old,jj,Next
516 c Write the structures to a scratch file
518 c Master sends the portion of conformations that have been read in to the neighbor
520 write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
523 call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
524 call MPI_Send(nss_all(1),icount,MPI_INTEGER,
525 & Next,571,MPI_COMM_WORLD,IERROR)
526 call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
527 & Next,572,MPI_COMM_WORLD,IERROR)
528 call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
529 & Next,573,MPI_COMM_WORLD,IERROR)
530 call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
531 & Next,577,MPI_COMM_WORLD,IERROR)
532 call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
533 & Next,579,MPI_COMM_WORLD,IERROR)
534 call MPI_Send(allcart(1,1,1),3*icount*maxres2,
535 & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
537 call dawrite_ccoords(jj_old,jj,icbase)
540 c------------------------------------------------------------------------------
542 subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,
546 include "sizesclu.dat"
548 integer IERROR,STATUS(MPI_STATUS_SIZE)
550 include "COMMON.CHAIN"
551 include "COMMON.SBRIDGE"
552 include "COMMON.INTERACT"
553 include "COMMON.IOUNITS"
556 include "COMMON.CLUSTER"
557 integer i,j,k,icount,jj_old,jj,Previous,Next
560 write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
563 do while (icount.gt.0)
564 call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
566 call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,
569 write (iout,*) "Processor",me," icount",icount
571 if (icount.eq.0) return
572 call MPI_Recv(nss_all(1),icount,MPI_INTEGER,
573 & Previous,571,MPI_COMM_WORLD,STATUS,IERROR)
574 call MPI_Send(nss_all(1),icount,MPI_INTEGER,
575 & Next,571,MPI_COMM_WORLD,IERROR)
576 call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,
577 & Previous,572,MPI_COMM_WORLD,STATUS,IERROR)
578 call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
579 & Next,572,MPI_COMM_WORLD,IERROR)
580 call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,
581 & Previous,573,MPI_COMM_WORLD,STATUS,IERROR)
582 call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
583 & Next,573,MPI_COMM_WORLD,IERROR)
584 call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
585 & Previous,577,MPI_COMM_WORLD,STATUS,IERROR)
586 call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
587 & Next,577,MPI_COMM_WORLD,IERROR)
588 call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
589 & Previous,579,MPI_COMM_WORLD,STATUS,IERROR)
590 call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
591 & Next,579,MPI_COMM_WORLD,IERROR)
592 call MPI_Recv(allcart(1,1,1),3*icount*maxres2,
593 & MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR)
594 call MPI_Send(allcart(1,1,1),3*icount*maxres2,
595 & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
597 call dawrite_ccoords(jj_old,jj,icbase)
600 write (iout,*) "Processor",me," received",icount," conformations"
602 write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
603 write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
604 write (iout,'(e15.5,16i5)') entfac(i)
611 c------------------------------------------------------------------------------
612 subroutine daread_ccoords(istart_conf,iend_conf)
615 include "sizesclu.dat"
620 include "COMMON.CHAIN"
621 include "COMMON.CLUSTER"
622 include "COMMON.IOUNITS"
623 include "COMMON.INTERACT"
625 include "COMMON.SBRIDGE"
627 integer istart_conf,iend_conf
628 integer i,j,ij,ii,iii
630 character*16 form,acc
633 c Read conformations off a DA scratchfile.
636 write (iout,*) "DAREAD_COORDS"
637 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
638 inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
639 write (iout,*) "len=",len," form=",form," acc=",acc
640 write (iout,*) "nam=",nam
643 do ii=istart_conf,iend_conf
644 ij = ii - istart_conf + 1
647 write (iout,*) "Reading binary file, record",iii," ii",ii
650 read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
651 & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
652 & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
653 & entfac(ii),rmstb(ii)
655 write (iout,*) ii,iii,ij,entfac(ii)
656 write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
657 write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),
658 & i=nnt+nres,nct+nres)
659 write (iout,'(2e15.5)') entfac(ij)
660 write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
661 & jhpb_all(i,ij),i=1,nss)
667 c------------------------------------------------------------------------------
668 subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out)
671 include "sizesclu.dat"
676 include "COMMON.CHAIN"
677 include "COMMON.INTERACT"
678 include "COMMON.IOUNITS"
680 include "COMMON.SBRIDGE"
682 include "COMMON.CLUSTER"
683 integer istart_conf,iend_conf
684 integer i,j,ii,ij,iii,unit_out
686 character*16 form,acc
689 c Write conformations to a DA scratchfile.
692 write (iout,*) "DAWRITE_COORDS"
693 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
694 write (iout,*) "lenrec",lenrec
695 inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
696 write (iout,*) "len=",len," form=",form," acc=",acc
697 write (iout,*) "nam=",nam
700 do ii=istart_conf,iend_conf
702 ij = ii - istart_conf + 1
704 write (iout,*) "Writing binary file, record",iii," ii",ii
707 write(unit_out,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_all(ij)),
710 & entfac(ii),rmstb(ii)
712 write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
713 write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
715 write (iout,'(2e15.5)') entfac(ij)
716 write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,