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.CONTROL"
367 include "COMMON.CHAIN"
368 include "COMMON.INTERACT"
369 include "COMMON.LOCAL"
370 include "COMMON.IOUNITS"
371 include "COMMON.NAMES"
373 include "COMMON.SBRIDGE"
375 integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib
376 & nn,nn1,inan,Next,itj,chalen
377 double precision etot,energia(0:max_ene)
379 chalen=int((nct-nnt+2)/symetr)
380 call int_from_cart1(.false.)
382 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
384 if (itel(j).ne.0 .and. itel(j-1).ne.0) then
385 write (iout,*) "Conformation",jjj,jj+1
386 write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j),
388 write (iout,*) "The Cartesian geometry is:"
389 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
390 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
391 write (iout,*) "The internal geometry is:"
392 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
393 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
394 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
395 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
396 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
397 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
399 & "This conformation WILL NOT be added to the database."
407 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
408 write (iout,*) "Conformation",jjj,jj+1
409 write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j)
410 write (iout,*) "The Cartesian geometry is:"
411 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
412 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
413 write (iout,*) "The internal geometry is:"
414 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
415 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
416 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
417 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
418 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
419 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
421 & "This conformation WILL NOT be added to the database."
426 if (theta(j).le.0.0d0) then
428 & "Zero theta angle(s) in conformation",jjj,jj+1
429 write (iout,*) "The Cartesian geometry is:"
430 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
431 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
432 write (iout,*) "The internal geometry is:"
433 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
434 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
435 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
436 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
437 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
438 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
440 & "This conformation WILL NOT be added to the database."
443 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
447 write (iout,*) "Conformation",jjj,jj
448 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
449 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
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)') (vbld(k+nres),k=nnt,nct)
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,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
458 write (iout,'(e15.5,16i5)') entfac(icount+1)
459 c & iscore(icount+1,0)
462 call store_cconf_from_file(jj,icount)
463 if (icount.eq.maxstr_proc) then
465 write (iout,* ) "jj_old",jj_old," jj",jj
467 call write_and_send_cconf(icount,jj_old,jj,Next)
473 c------------------------------------------------------------------------------
474 subroutine store_cconf_from_file(jj,icount)
477 include "sizesclu.dat"
478 include "COMMON.CLUSTER"
479 include "COMMON.CHAIN"
480 include "COMMON.SBRIDGE"
481 include "COMMON.INTERACT"
482 include "COMMON.IOUNITS"
484 integer i,j,jj,icount
485 c Store the conformation that has been read in
488 allcart(j,i,icount)=c(j,i)
493 ihpb_all(i,icount)=ihpb(i)
494 jhpb_all(i,icount)=jhpb(i)
498 c------------------------------------------------------------------------------
499 subroutine write_and_send_cconf(icount,jj_old,jj,Next)
502 include "sizesclu.dat"
508 include "COMMON.CHAIN"
509 include "COMMON.SBRIDGE"
510 include "COMMON.INTERACT"
511 include "COMMON.IOUNITS"
512 include "COMMON.CLUSTER"
514 integer icount,jj_old,jj,Next
515 c Write the structures to a scratch file
517 c Master sends the portion of conformations that have been read in to the neighbor
519 write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
522 call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR)
523 call MPI_Send(nss_all(1),icount,MPI_INTEGER,
524 & Next,571,MPI_COMM_WORLD,IERROR)
525 call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
526 & Next,572,MPI_COMM_WORLD,IERROR)
527 call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
528 & Next,573,MPI_COMM_WORLD,IERROR)
529 call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
530 & Next,577,MPI_COMM_WORLD,IERROR)
531 call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
532 & Next,579,MPI_COMM_WORLD,IERROR)
533 call MPI_Send(allcart(1,1,1),3*icount*maxres2,
534 & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
536 call dawrite_ccoords(jj_old,jj,icbase)
539 c------------------------------------------------------------------------------
541 subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous,
545 include "sizesclu.dat"
547 integer IERROR,STATUS(MPI_STATUS_SIZE)
549 include "COMMON.CHAIN"
550 include "COMMON.SBRIDGE"
551 include "COMMON.INTERACT"
552 include "COMMON.IOUNITS"
555 include "COMMON.CLUSTER"
556 integer i,j,k,icount,jj_old,jj,Previous,Next
559 write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
562 do while (icount.gt.0)
563 call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD,
565 call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,
568 write (iout,*) "Processor",me," icount",icount
570 if (icount.eq.0) return
571 call MPI_Recv(nss_all(1),icount,MPI_INTEGER,
572 & Previous,571,MPI_COMM_WORLD,STATUS,IERROR)
573 call MPI_Send(nss_all(1),icount,MPI_INTEGER,
574 & Next,571,MPI_COMM_WORLD,IERROR)
575 call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER,
576 & Previous,572,MPI_COMM_WORLD,STATUS,IERROR)
577 call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER,
578 & Next,572,MPI_COMM_WORLD,IERROR)
579 call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER,
580 & Previous,573,MPI_COMM_WORLD,STATUS,IERROR)
581 call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER,
582 & Next,573,MPI_COMM_WORLD,IERROR)
583 call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
584 & Previous,577,MPI_COMM_WORLD,STATUS,IERROR)
585 call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION,
586 & Next,577,MPI_COMM_WORLD,IERROR)
587 call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
588 & Previous,579,MPI_COMM_WORLD,STATUS,IERROR)
589 call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION,
590 & Next,579,MPI_COMM_WORLD,IERROR)
591 call MPI_Recv(allcart(1,1,1),3*icount*maxres2,
592 & MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR)
593 call MPI_Send(allcart(1,1,1),3*icount*maxres2,
594 & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR)
596 call dawrite_ccoords(jj_old,jj,icbase)
599 write (iout,*) "Processor",me," received",icount," conformations"
601 write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres)
602 write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct)
603 write (iout,'(e15.5,16i5)') entfac(i)
610 c------------------------------------------------------------------------------
611 subroutine daread_ccoords(istart_conf,iend_conf)
614 include "sizesclu.dat"
619 include "COMMON.CHAIN"
620 include "COMMON.CLUSTER"
621 include "COMMON.IOUNITS"
622 include "COMMON.INTERACT"
624 include "COMMON.SBRIDGE"
626 integer istart_conf,iend_conf
627 integer i,j,ij,ii,iii
629 character*16 form,acc
632 c Read conformations off a DA scratchfile.
635 write (iout,*) "DAREAD_COORDS"
636 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
637 inquire(unit=icbase,name=nam,recl=len,form=form,access=acc)
638 write (iout,*) "len=",len," form=",form," acc=",acc
639 write (iout,*) "nam=",nam
642 do ii=istart_conf,iend_conf
643 ij = ii - istart_conf + 1
646 write (iout,*) "Reading binary file, record",iii," ii",ii
649 read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
650 & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
651 & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss),
652 & entfac(ii),rmstb(ii)
654 write (iout,*) ii,iii,ij,entfac(ii)
655 write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
656 write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),
657 & i=nnt+nres,nct+nres)
658 write (iout,'(2e15.5)') entfac(ij)
659 write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij),
660 & jhpb_all(i,ij),i=1,nss)
666 c------------------------------------------------------------------------------
667 subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out)
670 include "sizesclu.dat"
675 include "COMMON.CHAIN"
676 include "COMMON.INTERACT"
677 include "COMMON.IOUNITS"
679 include "COMMON.SBRIDGE"
681 include "COMMON.CLUSTER"
682 integer istart_conf,iend_conf
683 integer i,j,ii,ij,iii,unit_out
685 character*16 form,acc
688 c Write conformations to a DA scratchfile.
691 write (iout,*) "DAWRITE_COORDS"
692 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
693 write (iout,*) "lenrec",lenrec
694 inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
695 write (iout,*) "len=",len," form=",form," acc=",acc
696 write (iout,*) "nam=",nam
699 do ii=istart_conf,iend_conf
701 ij = ii - istart_conf + 1
703 write (iout,*) "Writing binary file, record",iii," ii",ii
706 write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres),
707 & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres),
708 & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)),
709 & entfac(ii),rmstb(ii)
711 write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres)
712 write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres,
714 write (iout,'(2e15.5)') entfac(ij)
715 write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1,