source/maxlik/src_MD_T_maxlik-NEWCORR-PMF/geomout.F

   1       subroutine pdbout(etot,tytul)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'COMMON.CHAIN'
   6       include 'COMMON.INTERACT'
   7       include 'COMMON.NAMES'
   8       include 'COMMON.IOUNITS'
   9       include 'COMMON.HEADER'
  10       include 'COMMON.SBRIDGE'
  11       character*50 tytul
  12       dimension ica(maxres)
  13       write (ipdb,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
  14       iatom=0
  15       do i=nnt,nct
  16         ires=i-nnt+1
  17         iatom=iatom+1
  18         ica(i)=iatom
  19         iti=itype(i)
  20         write (ipdb,10) iatom,restyp(iti),ires,(c(j,i),j=1,3)
  21         if (iti.ne.10) then
  22           iatom=iatom+1
  23           write (ipdb,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3)
  24         endif
  25       enddo
  26       write (ipdb,'(a)') 'TER'
  27       do i=nnt,nct-1
  28         if (itype(i).eq.10) then
  29           write (ipdb,30) ica(i),ica(i+1)
  30         else
  31           write (ipdb,30) ica(i),ica(i+1),ica(i)+1
  32         endif
  33       enddo
  34       if (itype(nct).ne.10) then
  35         write (ipdb,30) ica(nct),ica(nct)+1
  36       endif
  37       do i=1,nss
  38         write (ipdb,30) ica(ihpb(i))+1,ica(jhpb(i))+1
  39       enddo
  40   10  FORMAT ('ATOM',I7,'  CA  ',A3,I6,4X,3F8.3)
  41   20  FORMAT ('ATOM',I7,'  CB  ',A3,I6,4X,3F8.3)
  42   30  FORMAT ('CONECT',8I5)
  43       return
  44       end
  45 c------------------------------------------------------------------------------
  46       subroutine MOL2out(etot,tytul)
  47 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
  48 C format.
  49       implicit real*8 (a-h,o-z)
  50       include 'DIMENSIONS'
  51       include 'DIMENSIONS.ZSCOPT'
  52       include 'COMMON.CHAIN'
  53       include 'COMMON.INTERACT'
  54       include 'COMMON.NAMES'
  55       include 'COMMON.IOUNITS'
  56       include 'COMMON.HEADER'
  57       include 'COMMON.SBRIDGE'
  58       character*32 tytul,fd
  59       character*3 liczba
  60       character*6 res_num,pom,ucase
  61 #ifdef AIX
  62       call fdate_(fd)
  63 #else
  64       call fdate(fd)
  65 #endif
  66       write (imol2,'(a)') '#'
  67       write (imol2,'(a)')
  68      & '#         Creating user name:           unres'
  69       write (imol2,'(2a)') '#         Creation time:                ',
  70      & fd
  71       write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
  72       write (imol2,'(a)') tytul
  73       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
  74       write (imol2,'(a)') 'SMALL'
  75       write (imol2,'(a)') 'USER_CHARGES'
  76       write (imol2,'(a)') '\@<TRIPOS>ATOM'
  77       do i=nnt,nct
  78         write (liczba,*) i
  79         pom=ucase(restyp(itype(i)))
  80         res_num = pom(:3)//liczba(2:)
  81         write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
  82       enddo
  83       write (imol2,'(a)') '\@<TRIPOS>BOND'
  84       do i=nnt,nct-1
  85         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
  86       enddo
  87       do i=1,nss
  88         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
  89       enddo
  90       write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
  91       do i=nnt,nct
  92         write (liczba,*) i
  93         pom = ucase(restyp(itype(i)))
  94         res_num = pom(:3)//liczba(2:)
  95         write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
  96       enddo
  97   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
  98   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
  99       return
 100       end
 101 c------------------------------------------------------------------------
 102       subroutine intout
 103       implicit real*8 (a-h,o-z)
 104       include 'DIMENSIONS'
 105       include 'DIMENSIONS.ZSCOPT'
 106       include 'COMMON.IOUNITS'
 107       include 'COMMON.CHAIN'
 108       include 'COMMON.VAR'
 109       include 'COMMON.LOCAL'
 110       include 'COMMON.INTERACT'
 111       include 'COMMON.NAMES'
 112       include 'COMMON.GEO'
 113       write (iout,'(/a)') 'Geometry of the virtual chain.'
 114       write (iout,'(6a)') '  Res  ','     Theta','       Phi',
 115      & '       Dsc','     Alpha','      Omega'
 116       do i=1,nres
 117         iti=itype(i)
 118         write (iout,'(a3,i4,5f10.3)') restyp(iti),i,rad2deg*theta(i),
 119      &     rad2deg*phi(i),dsc(iti),rad2deg*alph(i),rad2deg*omeg(i)
 120       enddo
 121       return
 122       end
 123 c---------------------------------------------------------------------------
 124       subroutine briefout(it,ener)
 125       implicit real*8 (a-h,o-z)
 126       include 'DIMENSIONS'
 127       include 'DIMENSIONS.ZSCOPT'
 128       include 'COMMON.IOUNITS'
 129       include 'COMMON.CHAIN'
 130       include 'COMMON.VAR'
 131       include 'COMMON.LOCAL'
 132       include 'COMMON.INTERACT'
 133       include 'COMMON.NAMES'
 134       include 'COMMON.GEO'
 135       include 'COMMON.SBRIDGE'
 136       print '(a,i5)',intname,igeom
 137 #if defined(AIX) || defined(PGI)
 138       open (igeom,file=intname,position='append')
 139 #else
 140       open (igeom,file=intname,access='append')
 141 #endif
 142       IF (NSS.LE.9) THEN
 143         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 144       ELSE
 145         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
 146         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
 147       ENDIF
 148 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 149       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 150       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 151 c     if (nvar.gt.nphi+ntheta) then
 152         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 153         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 154 c     endif
 155       close(igeom)
 156   180 format (I5,F12.3,I2,9(1X,2I3))
 157   190 format (3X,11(1X,2I3))
 158   200 format (8F10.4)
 159       return
 160       end