X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?p=unres.git;a=blobdiff_plain;f=source%2Fcluster%2Fwham%2Fsrc-M%2Fbakup%2Fread_coords.F;fp=source%2Fcluster%2Fwham%2Fsrc-M%2Fbakup%2Fread_coords.F;h=0000000000000000000000000000000000000000;hp=f177ab11724bdab4a789ebd83f4b31c1fac6ce86;hb=9453fc761eb545fcb727824c94d012dbf3931951;hpb=6f521277aa2a382d409f5189957283b0998b0d07 diff --git a/source/cluster/wham/src-M/bakup/read_coords.F b/source/cluster/wham/src-M/bakup/read_coords.F deleted file mode 100644 index f177ab1..0000000 --- a/source/cluster/wham/src-M/bakup/read_coords.F +++ /dev/null @@ -1,721 +0,0 @@ - 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 - -#define DEBUG -#ifdef DEBUG - write (iout,*) "Opening file ",intinname(:ilen(intinname)) - write (iout,*) "lenrec",lenrec_in - call flush(iout) -#endif -#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 - do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - if (iret.eq.0) goto 101 - call xdrfint_(ixdrf, jhpb(j), iret) - if (iret.eq.0) goto 101 - 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 - write (iout,*) "calling xdrf3dfcoord" - call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret) - 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 - call xdrfint(ixdrf, ihpb(k), iret) - if (iret.eq.0) goto 101 - call xdrfint(ixdrf, jhpb(k), iret) - if (iret.eq.0) goto 101 - 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 - entfac(jj+1)=refree - 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 -c#ifdef DEBUG - write (iout,*) "jj_old",jj_old," jj",jj -c#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,chalen - double precision etot,energia(0:max_ene) - jjj=jjj+1 - chalen=int((nct-nnt+2)/symetr) - call int_from_cart1(.false.) - do j=nnt+1,nct - if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) 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), - & chalen - 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(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) -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) - 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 - 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) -#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 - 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) -#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