subroutine read_coords(ncon,*) implicit none include "DIMENSIONS" include "sizesclu.dat" #ifdef MPI include "mpif.h" integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) include "COMMON.MPI" #endif include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.IOUNITS" include "COMMON.VAR" include "COMMON.SBRIDGE" include "COMMON.GEO" include "COMMON.CLUSTER" character*3 liczba integer ncon integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,if,ib, & nn,nn1,inan integer ixdrf,iret,itmp real*4 prec,reini,refree,rmsdev integer nrec,nlines,iscor,lenrec,lenrec_in double precision energ,t_acq,tcpu integer ilen,iroof external ilen,iroof double precision rjunk integer ntot_all(0:maxprocs-1) logical lerr double precision energia(0:max_ene),etot real*4 csingle(3,maxres2+2) integer Previous,Next character*256 bprotfiles c print *,"Processor",me," calls read_protein_data" #ifdef MPI if (me.eq.master) then Previous=MPI_PROC_NULL else Previous=me-1 endif if (me.eq.nprocs-1) then Next=MPI_PROC_NULL else Next=me+1 endif c Set the scratchfile names write (liczba,'(bz,i3.3)') me #endif c 1/27/05 AL Change stored coordinates to single precision and don't store c energy components in the binary databases. lenrec=12*(nres+nct-nnt+1)+4*(ns+2)+16 lenrec_in=12*(nres+nct-nnt+1)+4*(ns+2)+24 #ifdef DEBUG write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss", nss write (iout,*) "lenrec_in",lenrec_in #endif bprotfiles=scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//liczba//".xbin" #ifdef CHUJ ICON=1 123 continue if (from_cart .and. .not. from_bx .and. .not. from_cx) then if (lefree) then read (intin,*,end=13,err=11) energy(icon),totfree(icon), & rmstb(icon), & nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon), & i=1,nss_all(icon)),iscore(icon) else read (intin,*,end=13,err=11) energy(icon),rmstb(icon), & nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon), & i=1,nss_all(icon)),iscore(icon) endif read (intin,'(8f10.5)',end=13,err=10) & ((allcart(j,i,icon),j=1,3),i=1,nres), & ((allcart(j,i+nres,icon),j=1,3),i=nnt,nct) print *,icon,energy(icon),nss_all(icon),rmstb(icon) else read(intin,'(a80)',end=13,err=12) lineh read(lineh(:5),*,err=8) ic if (lefree) then read(lineh(6:),*,err=8) energy(icon) else read(lineh(6:),*,err=8) energy(icon) endif goto 9 8 ic=1 print *,'error, assuming e=1d10',lineh energy(icon)=1d10 nss=0 9 continue cold read(lineh(18:),*,end=13,err=11) nss_all(icon) ii = index(lineh(15:)," ")+15 read(lineh(ii:),*,end=13,err=11) nss_all(icon) IF (NSS_all(icon).LT.9) THEN read (lineh(20:),*,end=102) & (IHPB_all(I,icon),JHPB_all(I,icon),I=1,NSS_all(icon)), & iscore(icon) ELSE read (lineh(20:),*,end=102) & (IHPB_all(I,icon),JHPB_all(I,icon),I=1,8) read (intin,*) (IHPB_all(I,icon),JHPB_all(I,icon), & I=9,NSS_all(icon)),iscore(icon) ENDIF 102 continue PRINT *,'IC:',IC,' ENERGY:',ENERGY(ICON) call read_angles(intin,*13) do i=1,nres phiall(i,icon)=phi(i) thetall(i,icon)=theta(i) alphall(i,icon)=alph(i) omall(i,icon)=omeg(i) enddo endif ICON=ICON+1 GOTO 123 C C CALCULATE DISTANCES C 10 print *,'something wrong with angles' goto 13 11 print *,'something wrong with NSS',nss goto 13 12 print *,'something wrong with header' 13 NCON=ICON-1 #endif call flush(iout) jj_old=1 open (icbase,file=bprotfiles,status="unknown", & form="unformatted",access="direct",recl=lenrec) c Read conformations from binary DA files (one per batch) and write them to c a binary DA scratchfile. jj=0 jjj=0 #ifdef MPI write (liczba,'(bz,i3.3)') me IF (ME.EQ.MASTER) THEN c Only the master reads the database; it'll send it to the other procs c through a ring. #endif t_acq = tcpu() icount=0 if (from_bx) then open (intin,file=intinname,status="old",form="unformatted", & access="direct",recl=lenrec_in) else if (from_cx) then #if (defined(AIX) && !defined(JUBL)) call xdrfopen_(ixdrf,intinname, "r", iret) #else call xdrfopen(ixdrf,intinname, "r", iret) #endif prec=10000.0 write (iout,*) "xdrfopen: iret",iret if (iret.eq.0) then write (iout,*) "Error: coordinate file ", & intinname(:ilen(intinname))," does not exist." call flush(iout) #ifdef MPI call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE) #endif stop endif else write (iout,*) "Error: coordinate format not specified" call flush(iout) #ifdef MPI call MPI_ABORT(MPI_COMM_WORLD,IERROR,ERRCODE) #else stop #endif endif C#define DEBUG #ifdef DEBUG write (iout,*) "Opening file ",intinname(:ilen(intinname)) write (iout,*) "lenrec",lenrec_in call flush(iout) #endif C#undef DEBUG c write (iout,*) "maxconf",maxconf i=0 do while (.true.) i=i+1 if (i.gt.maxconf) then write (iout,*) "Error: too many conformations ", & "(",maxconf,") maximum." #ifdef MPI call MPI_Abort(MPI_COMM_WORLD,errcode,ierror) #endif stop endif c write (iout,*) "i",i c call flush(iout) if (from_bx) then read(intin,err=101,end=101) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & energy(jj+1), & entfac(jj+1),rmstb(jj+1),iscor do j=1,2*nres do k=1,3 c(k,j)=csingle(k,j) enddo enddo else #if (defined(AIX) && !defined(JUBL)) call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret) if (iret.eq.0) goto 101 call xdrfint_(ixdrf, nss, iret) if (iret.eq.0) goto 101 if (dyn_ss) then do k=1,nss call xdrfint(ixdrf, idssb(k), iret) call xdrfint(ixdrf, jdssb(k), iret) ihpb(k)=iss(idssb(k))+nres jhpb(k)=iss(jdssb(k))+nres #ifdef DEBUG write (iout,*) "jj",jj+1," dyn_ss:",idssb(k), & jdssb(k),ihpb(k),jhpb(k) #endif enddo else do k=1,nss call xdrfint(ixdrf, ihpb(k), iret) if (iret.eq.0) goto 101 call xdrfint(ixdrf, jhpb(k), iret) if (iret.eq.0) goto 101 #ifdef DEBUG write (iout,*) "jj",jj+1," stat_ss:",ihpb(k),jhpb(k) #endif enddo endif call xdrffloat_(ixdrf,reini,iret) if (iret.eq.0) goto 101 call xdrffloat_(ixdrf,refree,iret) if (iret.eq.0) goto 101 call xdrffloat_(ixdrf,rmsdev,iret) if (iret.eq.0) goto 101 call xdrfint_(ixdrf,iscor,iret) if (iret.eq.0) goto 101 #else c write (iout,*) "calling xdrf3dfcoord" call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret) c write (iout,*) "iret",iret c call flush(iout) if (iret.eq.0) goto 101 call xdrfint(ixdrf, nss, iret) c write (iout,*) "iret",iret c write (iout,*) "nss",nss call flush(iout) if (iret.eq.0) goto 101 if (dyn_ss) then do k=1,nss call xdrfint(ixdrf, idssb(k), iret) call xdrfint(ixdrf, jdssb(k), iret) ihpb(k)=iss(idssb(k))+nres jhpb(k)=iss(jdssb(k))+nres #ifdef DEBUG write (iout,*) "jj",jj+1," dyn_ss:",idssb(k), & jdssb(k),ihpb(k),jhpb(k) #endif enddo else do k=1,nss call xdrfint(ixdrf, ihpb(k), iret) if (iret.eq.0) goto 101 call xdrfint(ixdrf, jhpb(k), iret) if (iret.eq.0) goto 101 #ifdef DEBUG write (iout,*) "jj",jj+1," stat_ss:",ihpb(k),jhpb(k) #endif enddo endif call xdrffloat(ixdrf,reini,iret) if (iret.eq.0) goto 101 call xdrffloat(ixdrf,refree,iret) if (iret.eq.0) goto 101 call xdrffloat(ixdrf,rmsdev,iret) if (iret.eq.0) goto 101 call xdrfint(ixdrf,iscor,iret) if (iret.eq.0) goto 101 #endif energy(jj+1)=reini entfac(jj+1)=refree rmstb(jj+1)=rmsdev #ifdef DEBUG write (iout,*) "jj",jj+1," energy",energy(jj+1), & " entfac",entfac(jj+1)," rmsd",rmstb(jj+1) #endif do k=1,nres do l=1,3 c(l,k)=csingle(l,k) enddo enddo do k=nnt,nct do l=1,3 c(l,nres+k)=csingle(l,nres+k-nnt+1) enddo enddo endif C#define DEBUG #ifdef DEBUG write (iout,'(5hREAD ,i5,3f15.4,i10)') & jj+1,energy(jj+1),entfac(jj+1), & rmstb(jj+1),iscor write (iout,*) "Conformation",jjj+1,jj+1 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres) write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct) call flush(iout) #endif C#undef DEBUG call add_new_cconf(jjj,jj,jj_old,icount,Next) enddo 101 continue write (iout,*) i-1," conformations read from DA file ", & intinname(:ilen(intinname)) write (iout,*) jj," conformations read so far" if (from_bx) then close(intin) else #if (defined(AIX) && !defined(JUBL)) call xdrfclose_(ixdrf, iret) #else call xdrfclose(ixdrf, iret) #endif endif #ifdef MPI #ifdef DEBUG write (iout,*) "jj_old",jj_old," jj",jj #endif call write_and_send_cconf(icount,jj_old,jj,Next) call MPI_Send(0,1,MPI_INTEGER,Next,570, & MPI_COMM_WORLD,IERROR) jj_old=jj+1 #else call write_and_send_cconf(icount,jj_old,jj,Next) #endif t_acq = tcpu() - t_acq #ifdef MPI write (iout,*) "Processor",me, & " time for conformation read/send",t_acq ELSE c A worker gets the confs from the master and sends them to its neighbor t_acq = tcpu() call receive_and_pass_cconf(icount,jj_old,jj, & Previous,Next) t_acq = tcpu() - t_acq ENDIF #endif ncon=jj c close(icbase) close(intin) write(iout,*)"A total of",ncon," conformations read." #ifdef MPI c Check if everyone has the same number of conformations call MPI_Allgather(ncon,1,MPI_INTEGER, & ntot_all(0),1,MPI_INTEGER,MPI_Comm_World,IERROR) lerr=.false. do i=0,nprocs-1 if (i.ne.me) then if (ncon.ne.ntot_all(i)) then write (iout,*) "Number of conformations at processor",i, & " differs from that at processor",me, & ncon,ntot_all(i) lerr = .true. endif endif enddo if (lerr) then write (iout,*) write (iout,*) "Number of conformations read by processors" write (iout,*) do i=0,nprocs-1 write (iout,'(8i10)') i,ntot_all(i) enddo write (iout,*) "Calculation terminated." call flush(iout) return1 endif return #endif 1111 write(iout,*) "Error opening coordinate file ", & intinname(:ilen(intinname)) call flush(iout) return1 end c------------------------------------------------------------------------------ subroutine add_new_cconf(jjj,jj,jj_old,icount,Next) implicit none include "DIMENSIONS" include "sizesclu.dat" include "COMMON.CLUSTER" include "COMMON.CONTROL" include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.LOCAL" include "COMMON.IOUNITS" include "COMMON.NAMES" include "COMMON.VAR" include "COMMON.SBRIDGE" include "COMMON.GEO" integer i,j,jj,jjj,jj_old,icount,k,kk,l,ii,ib & nn,nn1,inan,Next,itj double precision etot,energia(0:max_ene) jjj=jjj+1 call int_from_cart1(.false.) do j=nnt+1,nct if ((vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) & .and.(itype(j).ne.ntyp1)) then if (j.gt.2) then if (itel(j).ne.0 .and. itel(j-1).ne.0) then write (iout,*) "Conformation",jjj,jj+1 write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),itel(j) write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct) write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres) write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres) write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1) write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1) write (iout,*) & "This conformation WILL NOT be added to the database." return endif endif endif enddo do j=nnt,nct itj=itype(j) if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0 & .and. itype(j).ne.ntyp1) then write (iout,*) "Conformation",jjj,jj+1 write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j) write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct) write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres) write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres) write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1) write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1) write (iout,*) & "This conformation WILL NOT be added to the database." return endif enddo do j=3,nres if (theta(j).le.0.0d0) then write (iout,*) & "Zero theta angle(s) in conformation",jjj,jj+1 write (iout,*) "The Cartesian geometry is:" write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,*) "The internal geometry is:" write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct) write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres) write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres) write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1) write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1) write (iout,*) & "This conformation WILL NOT be added to the database." return endif if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad enddo jj=jj+1 #ifdef DEBUG write (iout,*) "Conformation",jjj,jj write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres) write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct) write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct) write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres) write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres) write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct) write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1) write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1) write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss) write (iout,'(e15.5,16i5)') entfac(icount+1) c & iscore(icount+1,0) #endif icount=icount+1 call store_cconf_from_file(jj,icount) if (icount.eq.maxstr_proc) then #ifdef DEBUG write (iout,* ) "jj_old",jj_old," jj",jj #endif call write_and_send_cconf(icount,jj_old,jj,Next) jj_old=jj+1 icount=0 endif return end c------------------------------------------------------------------------------ subroutine store_cconf_from_file(jj,icount) implicit none include "DIMENSIONS" include "sizesclu.dat" include "COMMON.CLUSTER" include "COMMON.CHAIN" include "COMMON.SBRIDGE" include "COMMON.INTERACT" include "COMMON.IOUNITS" include "COMMON.VAR" integer i,j,jj,icount c Store the conformation that has been read in do i=1,2*nres do j=1,3 allcart(j,i,icount)=c(j,i) enddo enddo nss_all(icount)=nss do i=1,nss ihpb_all(i,icount)=ihpb(i) jhpb_all(i,icount)=jhpb(i) enddo return end c------------------------------------------------------------------------------ subroutine write_and_send_cconf(icount,jj_old,jj,Next) implicit none include "DIMENSIONS" include "sizesclu.dat" #ifdef MPI include "mpif.h" integer IERROR include "COMMON.MPI" #endif include "COMMON.CHAIN" include "COMMON.SBRIDGE" include "COMMON.INTERACT" include "COMMON.IOUNITS" include "COMMON.CLUSTER" include "COMMON.VAR" integer icount,jj_old,jj,Next c Write the structures to a scratch file #ifdef MPI c Master sends the portion of conformations that have been read in to the neighbor #ifdef DEBUG write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF" call flush(iout) #endif call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD,IERROR) call MPI_Send(nss_all(1),icount,MPI_INTEGER, & Next,571,MPI_COMM_WORLD,IERROR) call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER, & Next,572,MPI_COMM_WORLD,IERROR) call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER, & Next,573,MPI_COMM_WORLD,IERROR) call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION, & Next,577,MPI_COMM_WORLD,IERROR) call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION, & Next,579,MPI_COMM_WORLD,IERROR) call MPI_Send(allcart(1,1,1),3*icount*maxres2, & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR) #endif call dawrite_ccoords(jj_old,jj,icbase) #ifdef DEBUG write (iout,*) "Processor",me," exit WRITE_AND_SEND_CONF" call flush(iout) #endif return end c------------------------------------------------------------------------------ #ifdef MPI subroutine receive_and_pass_cconf(icount,jj_old,jj,Previous, & Next) implicit none include "DIMENSIONS" include "sizesclu.dat" include "mpif.h" integer IERROR,STATUS(MPI_STATUS_SIZE) include "COMMON.MPI" include "COMMON.CHAIN" include "COMMON.SBRIDGE" include "COMMON.INTERACT" include "COMMON.IOUNITS" include "COMMON.VAR" include "COMMON.GEO" include "COMMON.CLUSTER" integer i,j,k,l,icount,jj_old,jj,Previous,Next icount=1 #ifdef DEBUG write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF" call flush(iout) #endif do while (icount.gt.0) call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,MPI_COMM_WORLD, & STATUS,IERROR) call MPI_Send(icount,1,MPI_INTEGER,Next,570,MPI_COMM_WORLD, & IERROR) #ifdef DEBUG write (iout,*) "Processor",me," icount",icount #endif if (icount.eq.0) return call MPI_Recv(nss_all(1),icount,MPI_INTEGER, & Previous,571,MPI_COMM_WORLD,STATUS,IERROR) call MPI_Send(nss_all(1),icount,MPI_INTEGER, & Next,571,MPI_COMM_WORLD,IERROR) call MPI_Recv(ihpb_all(1,1),icount,MPI_INTEGER, & Previous,572,MPI_COMM_WORLD,STATUS,IERROR) call MPI_Send(ihpb_all(1,1),icount,MPI_INTEGER, & Next,572,MPI_COMM_WORLD,IERROR) call MPI_Recv(jhpb_all(1,1),icount,MPI_INTEGER, & Previous,573,MPI_COMM_WORLD,STATUS,IERROR) call MPI_Send(jhpb_all(1,1),icount,MPI_INTEGER, & Next,573,MPI_COMM_WORLD,IERROR) call MPI_Recv(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION, & Previous,577,MPI_COMM_WORLD,STATUS,IERROR) call MPI_Send(rmstb(jj_old),icount,MPI_DOUBLE_PRECISION, & Next,577,MPI_COMM_WORLD,IERROR) call MPI_Recv(entfac(jj_old),icount,MPI_DOUBLE_PRECISION, & Previous,579,MPI_COMM_WORLD,STATUS,IERROR) call MPI_Send(entfac(jj_old),icount,MPI_DOUBLE_PRECISION, & Next,579,MPI_COMM_WORLD,IERROR) call MPI_Recv(allcart(1,1,1),3*icount*maxres2, & MPI_REAL,Previous,580,MPI_COMM_WORLD,STATUS,IERROR) call MPI_Send(allcart(1,1,1),3*icount*maxres2, & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR) jj=jj_old+icount-1 call dawrite_ccoords(jj_old,jj,icbase) jj_old=jj+1 #ifdef DEBUG write (iout,*) "Processor",me," received",icount," conformations" do i=1,icount write (iout,'(8f10.4)') ((allcart(l,k,i),l=1,3),k=1,nres) write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3),k=nnt,nct) write (iout,'(e15.5,16i5)') entfac(i) enddo #endif enddo return end #endif c------------------------------------------------------------------------------ subroutine daread_ccoords(istart_conf,iend_conf) implicit none include "DIMENSIONS" include "sizesclu.dat" #ifdef MPI include "mpif.h" include "COMMON.MPI" #endif include "COMMON.CHAIN" include "COMMON.CLUSTER" include "COMMON.IOUNITS" include "COMMON.INTERACT" include "COMMON.VAR" include "COMMON.SBRIDGE" include "COMMON.GEO" integer istart_conf,iend_conf integer i,j,ij,ii,iii integer len character*16 form,acc character*80 nam c c Read conformations off a DA scratchfile. c C#define DEBUG #ifdef DEBUG write (iout,*) "DAREAD_COORDS" write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf inquire(unit=icbase,name=nam,recl=len,form=form,access=acc) write (iout,*) "len=",len," form=",form," acc=",acc write (iout,*) "nam=",nam call flush(iout) #endif do ii=istart_conf,iend_conf ij = ii - istart_conf + 1 iii=list_conf(ii) #ifdef DEBUG write (iout,*) "Reading binary file, record",iii," ii",ii call flush(iout) #endif c if (dyn_ss) then c read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), c & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), c & entfac(ii),rmstb(ii) c else read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), & entfac(ii),rmstb(ii) c endif #ifdef DEBUG write (iout,*) ii,iii,ij,entfac(ii) write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3), & i=nnt+nres,nct+nres) write (iout,'(2e15.5)') entfac(ij) write (iout,'(16i5)') nss_all(ij),(ihpb_all(i,ij), & jhpb_all(i,ij),i=1,nss) call flush(iout) #endif C#undef DEBUG enddo c write (iout,*) "just before leave" call flush(iout) return end c------------------------------------------------------------------------------ subroutine dawrite_ccoords(istart_conf,iend_conf,unit_out) implicit none include "DIMENSIONS" include "sizesclu.dat" #ifdef MPI include "mpif.h" include "COMMON.MPI" #endif include "COMMON.CHAIN" include "COMMON.INTERACT" include "COMMON.IOUNITS" include "COMMON.VAR" include "COMMON.SBRIDGE" include "COMMON.GEO" include "COMMON.CLUSTER" integer istart_conf,iend_conf integer i,j,ii,ij,iii,unit_out integer len character*16 form,acc character*32 nam c c Write conformations to a DA scratchfile. c #ifdef DEBUG write (iout,*) "DAWRITE_COORDS" write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf write (iout,*) "lenrec",lenrec inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc) write (iout,*) "len=",len," form=",form," acc=",acc write (iout,*) "nam=",nam call flush(iout) #endif do ii=istart_conf,iend_conf iii=list_conf(ii) ij = ii - istart_conf + 1 #ifdef DEBUG write (iout,*) "Writing binary file, record",iii," ii",ii call flush(iout) #endif c if (dyn_ss) then c write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), c & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)) c & entfac(ii),rmstb(ii) c else write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)), & entfac(ii),rmstb(ii) c endif #ifdef DEBUG write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres, & nct+nres) write (iout,'(2e15.5)') entfac(ij) write (iout,'(16i5)') nss_all(ij),(ihpb(i,ij),jhpb(i,ij),i=1, & nss_all(ij)) call flush(iout) #endif enddo return end