subroutine pdbout(etot,rmsd,tytul) 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.TEMPFAC' character*32 tytul dimension ica(maxres) write (ipdb,'(3a,1pe15.5,a,0pf6.2)') 'REMARK ',tytul(:20), & ' ENERGY ',etot,' RMS ',rmsd iatom=0 do i=nnt,nct ires=i-nnt+1 iatom=iatom+1 ica(i)=iatom iti=itype(i) write (ipdb,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),1.0d0, & tempfac(1,i) if (.not. caonly .and. iti.ne.10) then iatom=iatom+1 write (ipdb,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3), & 1.0d0,tempfac(2,i) endif enddo write (ipdb,'(a)') 'TER' if (caonly) then do i=nnt,nct-1 write (ipdb,30) ica(i),ica(i+1) enddo else do i=nnt,nct-2 if (itype(i).eq.10) then write (ipdb,30) ica(i),ica(i+1) else write (ipdb,30) ica(i),ica(i+1),ica(i)+1 endif enddo write (ipdb,30) ica(i),ica(i)+1 endif if (.not. caonly .and. itype(nct).ne.10) then write (ipdb,30) ica(nct),ica(nct)+1 endif do i=1,nss write (ipdb,30) ica(ihpb(i))+1,ica(jhpb(i))+1 enddo 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f6.2,f6.2) 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f6.2,f6.2) 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*4 liczba character*6 res_num,pom,ucase #ifdef AIX call fdate_(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,nct-nnt+1,0,0 write (imol2,'(a)') 'SMALL' write (imol2,'(a)') 'USER_CHARGES' write (imol2,'(a)') '@ATOM' do i=nnt,nct c write (liczba,*) i pom=ucase(restyp(itype(i))) c res_num = pom(:3)//liczba(2:) write (imol2,10) i-nnt+1,(c(j,i),j=1,3),i-nnt+1,pom,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 (liczba,'(i4)') i pom = ucase(restyp(itype(i))) c res_num = pom(:3)//liczba(2:) write (imol2,30) i-nnt+1,pom,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 real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' write (iout,'(/a)') 'Geometry of the virtual chain.' write (iout,'(6a)') ' Res ',' Theta',' Phi', & ' Dsc',' Alpha',' Omega' do i=1,nres iti=itype(i) write (iout,'(a3,i4,5f10.3)') restyp(iti),i,rad2deg*theta(i), & rad2deg*phi(i),dsc(iti),rad2deg*alph(i),rad2deg*omeg(i) enddo return end c--------------------------------------------------------------------------- subroutine briefout(it,klasa,ener,free,nss,ihpb,jhpb,plik) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' dimension ihpb(maxss),jhpb(maxss) character*80 plik c print '(a,i5)',intname,igeom #ifdef AIX open (igeom,file=plik,position='append') #else open (igeom,file=plik,position='append') #endif IF (NSS.LT.9) THEN WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,NSS) ELSE WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,8) write (igeom,'(a)') WRITE (igeom,190) (IHPB(I),JHPB(I),I=9,NSS) ENDIF write (igeom,'(i10)') klasa 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,2F12.3,I2,$,8(1X,2I3,$)) 190 format (3X,11(1X,2I3,$)) 200 format (8F10.4) return end c--------------------------------------------------------------------------- subroutine cartout(igr,i,etot,free,rmsd,plik) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' include 'COMMON.CLUSTER' character*80 plik open (igeom,file=plik,position='append') write (igeom,'(2e15.5,f10.5,$)') etot,free,rmsd write (igeom,'(i4,$)') & nss_all(i),(ihpb_all(j,i),jhpb_all(j,i),j=1,nss_all(i)) write (igeom,'(i10)') iscore(i) write (igeom,'(8f10.5)') & ((allcart(k,j,i),k=1,3),j=1,nres), & ((allcart(k,j+nres,i),k=1,3),j=nnt,nct) return end