source/analysis/src-M-prop/geomout.F

   1       subroutine pdbout(etot,rmsd,tytul)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'COMMON.CONTROL'
   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       include 'COMMON.TEMPFAC'
  12       character*50 tytul
  13       character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
  14       dimension ica(maxres)
  15       write (ipdb,'(3a,1pe15.5,a,0pf7.2)') 'REMARK ',tytul(:20),
  16      &  ' ENERGY ',etot,' RMS ',rmsd
  17       iatom=0
  18       ires=0
  19       do i=nnt,nct
  20         iti=itype(i)
  21         if (iti.eq.ntyp1) then
  22           ires=0
  23           write (ipdb,'(a)') 'TER'
  24         else
  25         ires=ires+1
  26         iatom=iatom+1
  27         ica(i)=iatom
  28         write (ipdb,10) iatom,restyp(iti),chainid(nres_chain(i)),
  29      &     ires,(c(j,i),j=1,3),1.0d0,tempfac(1,i)
  30         if (iti.ne.10) then
  31           iatom=iatom+1
  32           write (ipdb,20) iatom,restyp(iti),chainid(nres_chain(i)),
  33      &      ires,(c(j,nres+i),j=1,3),1.0d0,tempfac(2,i)
  34         endif
  35         endif
  36       enddo
  37       write (ipdb,'(a)') 'TER'
  38       do i=nnt,nct-1
  39         if (itype(i).eq.ntyp1) cycle
  40         if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
  41           write (ipdb,30) ica(i),ica(i+1)
  42         else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
  43           write (ipdb,30) ica(i),ica(i+1),ica(i)+1
  44         else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
  45           write (ipdb,30) ica(i),ica(i)+1
  46         endif
  47       enddo
  48       if (itype(nct).ne.10) then
  49         write (ipdb,30) ica(nct),ica(nct)+1
  50       endif
  51       do i=1,nss
  52         write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
  53       enddo
  54       write (ipdb,'(a6)') 'ENDMDL'
  55   10  FORMAT ('ATOM',I7,'  CA  ',A3,1X,A1,I4,4X,3F8.3,2f6.2)
  56   20  FORMAT ('ATOM',I7,'  CB  ',A3,1X,A1,I4,4X,3F8.3,2f6.2)
  57   30  FORMAT ('CONECT',8I5)
  58       return
  59       end
  60 c------------------------------------------------------------------------------
  61       subroutine MOL2out(etot,tytul)
  62 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
  63 C format.
  64       implicit real*8 (a-h,o-z)
  65       include 'DIMENSIONS'
  66       include 'COMMON.CHAIN'
  67       include 'COMMON.INTERACT'
  68       include 'COMMON.NAMES'
  69       include 'COMMON.IOUNITS'
  70       include 'COMMON.HEADER'
  71       include 'COMMON.SBRIDGE'
  72       character*32 tytul,fd
  73       character*4 liczba
  74       character*6 res_num,pom,ucase
  75 #ifdef AIX
  76       call fdate_(fd)
  77 #else
  78       call fdate(fd)
  79 #endif
  80       write (imol2,'(a)') '#'
  81       write (imol2,'(a)')
  82      & '#         Creating user name:           unres'
  83       write (imol2,'(2a)') '#         Creation time:                ',
  84      & fd
  85       write (imol2,'(/a)') '@<TRIPOS>MOLECULE'
  86       write (imol2,'(a)') tytul
  87       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss,nct-nnt+1,0,0
  88       write (imol2,'(a)') 'SMALL'
  89       write (imol2,'(a)') 'USER_CHARGES'
  90       write (imol2,'(a)') '@<TRIPOS>ATOM'
  91       do i=nnt,nct
  92 c        write (liczba,*) i
  93         pom=ucase(restyp(itype(i)))
  94 c        res_num = pom(:3)//liczba(2:)
  95         write (imol2,10) i-nnt+1,(c(j,i),j=1,3),i-nnt+1,pom,0.0
  96       enddo
  97       write (imol2,'(a)') '@<TRIPOS>BOND'
  98       do i=nnt,nct-1
  99         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
 100       enddo
 101       do i=1,nss
 102         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
 103       enddo
 104       write (imol2,'(a)') '@<TRIPOS>SUBSTRUCTURE'
 105       do i=nnt,nct
 106         write (liczba,'(i4)') i
 107         pom = ucase(restyp(itype(i)))
 108 c        res_num = pom(:3)//liczba(2:)
 109         write (imol2,30) i-nnt+1,pom,i-nnt+1,0
 110       enddo
 111   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
 112   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
 113       return
 114       end
 115 c------------------------------------------------------------------------
 116       subroutine intout
 117       implicit real*8 (a-h,o-z)
 118       include 'DIMENSIONS'
 119       include 'COMMON.IOUNITS'
 120       include 'COMMON.CHAIN'
 121       include 'COMMON.VAR'
 122       include 'COMMON.LOCAL'
 123       include 'COMMON.INTERACT'
 124       include 'COMMON.NAMES'
 125       include 'COMMON.GEO'
 126       write (iout,'(/a)') 'Geometry of the virtual chain.'
 127       write (iout,'(6a)') '  Res  ','     Theta','       Phi',
 128      & '       Dsc','     Alpha','      Omega'
 129       do i=1,nres
 130         iti=itype(i)
 131         write (iout,'(a3,i4,5f10.3)') restyp(iti),i,rad2deg*theta(i),
 132      &     rad2deg*phi(i),dsc(iti),rad2deg*alph(i),rad2deg*omeg(i)
 133       enddo
 134       return
 135       end
 136 c---------------------------------------------------------------------------
 137       subroutine briefout(it,klasa,ener,free,nss,ihpb,jhpb,plik)
 138       implicit real*8 (a-h,o-z)
 139       include 'DIMENSIONS'
 140       include 'COMMON.IOUNITS'
 141       include 'COMMON.CHAIN'
 142       include 'COMMON.VAR'
 143       include 'COMMON.LOCAL'
 144       include 'COMMON.INTERACT'
 145       include 'COMMON.NAMES'
 146       include 'COMMON.GEO'
 147       dimension ihpb(maxss),jhpb(maxss)
 148       character*80 plik
 149 c     print '(a,i5)',intname,igeom
 150 #ifdef AIX
 151       open (igeom,file=plik,position='append')
 152 #else
 153       open (igeom,file=plik,position='append')
 154 #endif
 155       IF (NSS.LT.9) THEN
 156         WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 157       ELSE
 158         WRITE (igeom,180) IT,ENER,free,NSS,(IHPB(I),JHPB(I),I=1,8)
 159         write (igeom,'(a)')
 160         WRITE (igeom,190) (IHPB(I),JHPB(I),I=9,NSS)
 161       ENDIF
 162       write (igeom,'(i10)') klasa
 163 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 164       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 165       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 166 c     if (nvar.gt.nphi+ntheta) then
 167         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 168         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 169 c     endif
 170       close(igeom)
 171   180 format (I5,2F12.3,I2,$,8(1X,2I3,$))
 172   190 format (3X,11(1X,2I3,$))
 173   200 format (8F10.4)
 174       return
 175       end
 176 c---------------------------------------------------------------------------
 177       subroutine cartout(igr,i,etot,free,rmsd,plik)
 178       implicit real*8 (a-h,o-z)
 179       include 'DIMENSIONS'
 180       include 'sizesclu.dat'
 181       include 'COMMON.IOUNITS'
 182       include 'COMMON.CHAIN'
 183       include 'COMMON.VAR'
 184       include 'COMMON.LOCAL'
 185       include 'COMMON.INTERACT'
 186       include 'COMMON.NAMES'
 187       include 'COMMON.GEO'
 188       include 'COMMON.CLUSTER'
 189       character*80 plik
 190       open (igeom,file=plik,position='append')
 191       write (igeom,'(2e15.5,f10.5,$)') etot,free,rmsd
 192       write (igeom,'(i4,$)')
 193      &  nss_all(i),(ihpb_all(j,i),jhpb_all(j,i),j=1,nss_all(i))
 194       write (igeom,'(i10)') iscore(i)
 195       write (igeom,'(8f10.5)')
 196      &  ((allcart(k,j,i),k=1,3),j=1,nres),
 197      &  ((allcart(k,j+nres,i),k=1,3),j=nnt,nct)
 198       return
 199       end