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*(2*nss+2)+16 lenrec_in=12*(nres+nct-nnt+1)+4*(2*nss+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 (efree) 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 (efree) 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 #ifdef DEBUG write (iout,*) "Opening file ",intinname(:ilen(intinname)) write (iout,*) "lenrec",lenrec_in call flush(iout) #endif 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 do j=1,nss cc if (dyn_ss) then cc call xdrfint_(ixdrf, idssb(j), iret) cc if (iret.eq.0) goto 101 cc call xdrfint_(ixdrf, jdssb(j), iret) cc if (iret.eq.0) goto 101 cc idssb(j)=idssb(j)-nres cc jdssb(j)=jdssb(j)-nres cc else call xdrfint_(ixdrf, ihpb(j), iret) if (iret.eq.0) goto 101 call xdrfint_(ixdrf, jhpb(j), iret) if (iret.eq.0) goto 101 cc endif enddo 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 do k=1,nss cc if (dyn_ss) then cc call xdrfint(ixdrf, idssb(k), iret) cc if (iret.eq.0) goto 101 cc call xdrfint(ixdrf, jdssb(k), iret) cc if (iret.eq.0) goto 101 cc idssb(k)=idssb(k)-nres cc jdssb(k)=jdssb(k)-nres cc write(iout,*) "TUTU", idssb(k),jdssb(k) cc else call xdrfint(ixdrf, ihpb(k), iret) if (iret.eq.0) goto 101 call xdrfint(ixdrf, jhpb(k), iret) if (iret.eq.0) goto 101 cc endif enddo 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 cc write(iout,*) 'reini=', reini, jj+1 entfac(jj+1)=dble(refree) cc write(iout,*) 'refree=', refree,jj+1 rmstb(jj+1)=rmsdev 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 #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 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.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) then write (iout,*) "Conformation",jjj,jj+1 write (iout,*) "Bad CA-CA bond length",j," ",vbld(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=nnt,nct itj=itype(j) if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) 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), & 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) 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,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*32 nam c c Read conformations off a DA scratchfile. c #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 if (dyn_ss) then 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), c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), & entfac(ii),rmstb(ii) 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) 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 enddo 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 if (dyn_ss) then 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), c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)) & entfac(ii),rmstb(ii) 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) 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