subroutine pdbout(etot,tytul,iunit) implicit none include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.FRAG' include 'COMMON.MD' #ifdef FIVEDIAG include 'COMMON.LAGRANGE.5diag' #else include 'COMMON.LAGRANGE' #endif character*50 tytul integer iunit character*1 chainid(52) /'A','B','C','D','E','F','G','H','I','J', & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z', & 'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p', & 'q','r','s','t','u','v','w','x','y','z'/ integer ica(maxres) integer i,j,k,iti,itj,itk,itl,iatom,ichain,ires double precision etot write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot cmodel write (iunit,'(a5,i6)') 'MODEL',1 if (nhfrag.gt.0) then do j=1,nhfrag iti=itype(hfrag(1,j)) itj=itype(hfrag(2,j)) if (j.lt.10) then write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)') & 'HELIX',j,'H',j, & restyp(iti),hfrag(1,j)-1, & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) else write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)') & 'HELIX',j,'H',j, & restyp(iti),hfrag(1,j)-1, & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) endif enddo endif if (nbfrag.gt.0) then do j=1,nbfrag iti=itype(bfrag(1,j)) itj=itype(bfrag(2,j)-1) write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)') & 'SHEET',1,'B',j,2, & restyp(iti),bfrag(1,j)-1, & restyp(itj),bfrag(2,j)-2,0 if (bfrag(3,j).gt.bfrag(4,j)) then itk=itype(bfrag(3,j)) itl=itype(bfrag(4,j)+1) write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') & 'SHEET',2,'B',j,2, & restyp(itl),bfrag(4,j), & restyp(itk),bfrag(3,j)-1,-1, & "N",restyp(itk),bfrag(3,j)-1, & "O",restyp(iti),bfrag(1,j)-1 else itk=itype(bfrag(3,j)) itl=itype(bfrag(4,j)-1) write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') & 'SHEET',2,'B',j,2, & restyp(itk),bfrag(3,j)-1, & restyp(itl),bfrag(4,j)-2,1, & "N",restyp(itk),bfrag(3,j)-1, & "O",restyp(iti),bfrag(1,j)-1 endif enddo endif if (nss.gt.0) then do i=1,nss if (dyn_ss) then write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') & 'SSBOND',i,'CYS',iss(idssb(i))-nnt+1, & 'CYS',iss(jdssb(i))-nnt+1 else write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, & 'CYS',jhpb(i)-nnt+1-nres endif enddo endif iatom=0 ichain=1 ires=0 do i=nnt,nct iti=itype(i) if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then ichain=ichain+1 if (ichain.gt.52) ichain=1 ires=0 write (iunit,'(a)') 'TER' else if (iti.ne.ntyp1) then ires=ires+1 iatom=iatom+1 ica(i)=iatom if (iti.ne.ntyp1) then write (iunit,10) iatom,restyp(iti),chainid(ichain), & ires,(c(j,i),j=1,3),vtot(i) if (iti.ne.10) then iatom=iatom+1 write (iunit,20) iatom,restyp(iti),chainid(ichain), & ires,(c(j,nres+i),j=1,3), & vtot(i+nres) endif endif endif enddo write (iunit,'(a)') 'TER' do i=nnt,nct-1 if (itype(i).eq.ntyp1) cycle if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then write (iunit,30) ica(i),ica(i+1) else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then write (iunit,30) ica(i),ica(i+1),ica(i)+1 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then write (iunit,30) ica(i),ica(i)+1 endif enddo if (itype(nct).ne.10) then write (iunit,30) ica(nct),ica(nct)+1 endif do i=1,nss if (dyn_ss) then write (iunit,30) ica(iss(idssb(i)))+1,ica(iss(jdssb(i)))+1 else write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 endif enddo write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3) 30 FORMAT ('CONECT',8I5) return end c------------------------------------------------------------------------------ subroutine MOL2out(etot,tytul) C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 C format. implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' character*32 tytul,fd character*3 zahl character*6 res_num,pom,ucase double precision etot #ifdef AIX call fdate_(fd) #elif (defined CRAY) call date(fd) #else call fdate(fd) #endif write (imol2,'(a)') '#' write (imol2,'(a)') & '# Creating user name: unres' write (imol2,'(2a)') '# Creation time: ', & fd write (imol2,'(/a)') '\@MOLECULE' write (imol2,'(a)') tytul write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0 write (imol2,'(a)') 'SMALL' write (imol2,'(a)') 'USER_CHARGES' write (imol2,'(a)') '\@ATOM' do i=nnt,nct write (zahl,'(i3)') i pom=ucase(restyp(itype(i))) res_num = pom(:3)//zahl(2:) write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0 enddo write (imol2,'(a)') '\@BOND' do i=nnt,nct-1 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 enddo do i=1,nss write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 enddo write (imol2,'(a)') '\@SUBSTRUCTURE' do i=nnt,nct write (zahl,'(i3)') i pom = ucase(restyp(itype(i))) res_num = pom(:3)//zahl(2:) write (imol2,30) i-nnt+1,res_num,i-nnt+1,0 enddo 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****') 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****') return end c------------------------------------------------------------------------ subroutine intout implicit none include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' include 'COMMON.TORSION' integer i,iti write (iout,'(/a)') 'Geometry of the virtual chain.' write (iout,'(7a)') ' Res ',' d',' Theta', & ' Phi',' Dsc',' Alpha',' Omega' do i=1,nres iti=itype(i) write (iout,'(a3,i5,6f10.3)') restyp(iti),i,vbld(i), & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), & rad2deg*omeg(i) enddo return end c--------------------------------------------------------------------------- subroutine briefout(it,ener) implicit none include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' include 'COMMON.SBRIDGE' integer it,ener,i c print '(a,i5)',intname,igeom #if defined(AIX) || defined(PGI) || defined(CRAY) open (igeom,file=intname,position='append') #else open (igeom,file=intname,access='append') #endif IF (NSS.LE.9) THEN WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS) ELSE WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9) WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) ENDIF c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES) c if (nvar.gt.nphi+ntheta) then write (igeom,200) (rad2deg*alph(i),i=2,nres-1) write (igeom,200) (rad2deg*omeg(i),i=2,nres-1) c endif close(igeom) 180 format (I5,F12.3,I2,9(1X,2I3)) 190 format (3X,11(1X,2I3)) 200 format (8F10.4) return end #ifdef WINIFL subroutine fdate(fd) character*32 fd write(fd,'(32x)') return end #endif c---------------------------------------------------------------- #ifdef NOXDR subroutine cartout(time) #else subroutine cartoutx(time) #endif implicit none include 'DIMENSIONS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.FRAG' include 'COMMON.MD' include 'COMMON.QRESTR' integer i,j,k double precision time #if defined(AIX) || defined(PGI) || defined(CRAY) open(icart,file=cartname,position="append") #else open(icart,file=cartname,access="append") #endif write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath if (dyn_ss) then write (icart,'(i4,$)') & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) else write (icart,'(i4,$)') & nss,(ihpb(j),jhpb(j),j=1,nss) endif write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) write (icart,'(8f10.5)') & ((c(k,j),k=1,3),j=1,nres), & ((c(k,j+nres),k=1,3),j=nnt,nct) close(icart) return end c----------------------------------------------------------------- #ifndef NOXDR subroutine cartout(time) implicit none include 'DIMENSIONS' #ifdef MPI include 'mpif.h' include 'COMMON.SETUP' #else parameter (me=0) #endif include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.FRAG' include 'COMMON.MD' include 'COMMON.QRESTR' double precision time integer iret,itmp real xcoord(3,maxres2+2),prec integer i,j,ixdrf #ifdef AIX call xdrfopen_(ixdrf,cartname, "a", iret) call xdrffloat_(ixdrf, real(time), iret) call xdrffloat_(ixdrf, real(potE), iret) call xdrffloat_(ixdrf, real(uconst), iret) call xdrffloat_(ixdrf, real(uconst_back), iret) call xdrffloat_(ixdrf, real(t_bath), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then if (modecalc.eq.14) then call xdrfint_(ixdrf, idssb(j), iret) call xdrfint_(ixdrf, jdssb(j), iret) else call xdrfint_(ixdrf, iss(idssb(j))+nres, iret) call xdrfint_(ixdrf, iss(jdssb(j))+nres, iret) endif else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) endif enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag call xdrffloat_(ixdrf, real(qfrag(i)), iret) enddo do i=1,npair call xdrffloat_(ixdrf, real(qpair(i)), iret) enddo do i=1,nfrag_back call xdrffloat_(ixdrf, real(utheta(i)), iret) call xdrffloat_(ixdrf, real(ugamma(i)), iret) call xdrffloat_(ixdrf, real(uscdiff(i)), iret) enddo #else call xdrfopen(ixdrf,cartname, "a", iret) c write (iout,*) "Writing conformation: time",time," potE",potE, c & " uconst",uconst," uconst_back",uconst_back," t_bath",t_bath, c & " nss",nss call xdrffloat(ixdrf, real(time), iret) call xdrffloat(ixdrf, real(potE), iret) call xdrffloat(ixdrf, real(uconst), iret) call xdrffloat(ixdrf, real(uconst_back), iret) call xdrffloat(ixdrf, real(t_bath), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss if (dyn_ss) then if (modecalc.eq.14) then call xdrfint(ixdrf, idssb(j), iret) call xdrfint(ixdrf, jdssb(j), iret) else call xdrfint(ixdrf, iss(idssb(j))+nres, iret) call xdrfint(ixdrf, iss(jdssb(j))+nres, iret) endif else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag call xdrffloat(ixdrf, real(qfrag(i)), iret) enddo do i=1,npair call xdrffloat(ixdrf, real(qpair(i)), iret) enddo do i=1,nfrag_back call xdrffloat(ixdrf, real(utheta(i)), iret) call xdrffloat(ixdrf, real(ugamma(i)), iret) call xdrffloat(ixdrf, real(uscdiff(i)), iret) enddo #endif prec=10000.0 do i=1,nres do j=1,3 xcoord(j,i)=c(j,i) enddo enddo do i=nnt,nct do j=1,3 xcoord(j,nres+i-nnt+1)=c(j,i+nres) enddo enddo itmp=nres+nct-nnt+1 #ifdef AIX call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) call xdrfclose_(ixdrf, iret) #else call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) call xdrfclose(ixdrf, iret) #endif return end #endif c----------------------------------------------------------------- subroutine statout(itime) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.IOUNITS' include 'COMMON.HEADER' include 'COMMON.SBRIDGE' include 'COMMON.FRAG' include 'COMMON.MD' include 'COMMON.QRESTR' include 'COMMON.REMD' include 'COMMON.SETUP' integer itime double precision energia(0:n_ene) double precision gyrate external gyrate common /gucio/ cm character*256 line1,line2 character*4 format1,format2 character*30 format #ifdef AIX if(itime.eq.0) then open(istat,file=statname,position="append") endif #else #if defined(PGI) || defined(CRAY) open(istat,file=statname,position="append") #else open(istat,file=statname,access="append") #endif #endif if (AFMlog.gt.0) then if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)') & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(), & potEcomp(23),me format1="a133" else C print *,'A CHUJ',potEcomp(23) write (line1,'(i10,f15.2,7f12.3,i5,$)') & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & kinetic_T,t_bath,gyrate(), & potEcomp(23),me format1="a114" endif else if (selfguide.gt.0) then distance=0.0 do j=1,3 distance=distance+(c(j,afmend)-c(j,afmbeg))**2 enddo distance=dsqrt(distance) if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2, & f9.3,i5,$)') & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(), & distance,potEcomp(23),me format1="a133" C print *,"CHUJOWO" else C print *,'A CHUJ',potEcomp(23) write (line1,'(i10,f15.2,8f12.3,i5,$)') & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & kinetic_T,t_bath,gyrate(), & distance,potEcomp(23),me format1="a114" endif else if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me format1="a133" else write (line1,'(i10,f15.2,7f12.3,i5,$)') & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & amax,kinetic_T,t_bath,gyrate(),me format1="a114" endif endif if(usampl.and.totT.gt.eq_time) then if (loc_qlike) then write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back), & ((qloc(j,i),j=1,3),i=1,nfrag_back) write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair & +42*nfrag_back else write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair & +21*nfrag_back endif else format2="a001" line2=' ' endif if (print_compon) then if(itime.eq.0) then write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",31a12)" write (istat,format) "#"," ", & (ename(print_order(i)),i=1,nprint_ene) endif write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",31f12.3)" write (istat,format) line1,line2, & (potEcomp(print_order(i)),i=1,nprint_ene) else write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")" write (istat,format) line1,line2 endif #if defined(AIX) call flush(istat) #else close(istat) #endif return end c--------------------------------------------------------------- double precision function gyrate() implicit none include 'DIMENSIONS' include 'COMMON.INTERACT' include 'COMMON.CHAIN' integer i,ii,j double precision cen(3),rg do j=1,3 cen(j)=0.0d0 enddo ii=0 do i=nnt,nct if (itype(i).eq.ntyp1) cycle ii=ii+1 do j=1,3 cen(j)=cen(j)+c(j,i) enddo enddo do j=1,3 cen(j)=cen(j)/dble(ii) enddo rg = 0.0d0 do i = nnt, nct if (itype(i).eq.ntyp1) cycle do j=1,3 rg = rg + (c(j,i)-cen(j))**2 enddo end do gyrate = dsqrt(rg/dble(ii)) return end