source/unres/src_CSA/geomout_min.F

   1       subroutine pdbout(etot,tytul,iunit)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'COMMON.CHAIN'
   5       include 'COMMON.INTERACT'
   6       include 'COMMON.NAMES'
   7       include 'COMMON.IOUNITS'
   8       include 'COMMON.HEADER'
   9       include 'COMMON.SBRIDGE'
  10       include 'COMMON.DISTFIT'
  11       include 'COMMON.MD_'
  12       character*50 tytul
  13       dimension ica(maxres)
  14       write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
  15 cmodel      write (iunit,'(a5,i6)') 'MODEL',1
  16       if (nhfrag.gt.0) then
  17        do j=1,nhfrag
  18         iti=itype(hfrag(1,j))
  19         itj=itype(hfrag(2,j))
  20         if (j.lt.10) then
  21            write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
  22      &           'HELIX',j,'H',j,
  23      &           restyp(iti),hfrag(1,j)-1,
  24      &           restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
  25         else
  26            write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3,t76,i5)')
  27      &           'HELIX',j,'H',j,
  28      &           restyp(iti),hfrag(1,j)-1,
  29      &           restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
  30         endif
  31        enddo
  32       endif
  33
  34       if (nbfrag.gt.0) then
  35
  36        do j=1,nbfrag
  37
  38         iti=itype(bfrag(1,j))
  39         itj=itype(bfrag(2,j)-1)
  40
  41         write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
  42      &           'SHEET',1,'B',j,2,
  43      &           restyp(iti),bfrag(1,j)-1,
  44      &           restyp(itj),bfrag(2,j)-2,0
  45
  46         if (bfrag(3,j).gt.bfrag(4,j)) then
  47
  48          itk=itype(bfrag(3,j))
  49          itl=itype(bfrag(4,j)+1)
  50
  51          write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
  52      &              2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
  53      &           'SHEET',2,'B',j,2,
  54      &           restyp(itl),bfrag(4,j),
  55      &           restyp(itk),bfrag(3,j)-1,-1,
  56      &           "N",restyp(itk),bfrag(3,j)-1,
  57      &           "O",restyp(iti),bfrag(1,j)-1
  58
  59         else
  60
  61          itk=itype(bfrag(3,j))
  62          itl=itype(bfrag(4,j)-1)
  63
  64
  65         write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
  66      &              2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
  67      &           'SHEET',2,'B',j,2,
  68      &           restyp(itk),bfrag(3,j)-1,
  69      &           restyp(itl),bfrag(4,j)-2,1,
  70      &           "N",restyp(itk),bfrag(3,j)-1,
  71      &           "O",restyp(iti),bfrag(1,j)-1
  72
  73
  74
  75         endif
  76
  77        enddo
  78       endif
  79
  80       if (nss.gt.0) then
  81         do i=1,nss
  82           write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
  83      &         'SSBOND',i,'CYS',ihpb(i)-1-nres,
  84      &                    'CYS',jhpb(i)-1-nres
  85         enddo
  86       endif
  87
  88       iatom=0
  89       do i=nnt,nct
  90         ires=i-nnt+1
  91         iatom=iatom+1
  92         ica(i)=iatom
  93         iti=itype(i)
  94         write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i)
  95         if (iti.ne.10) then
  96           iatom=iatom+1
  97           write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3),
  98      &      vtot(i+nres)
  99         endif
 100       enddo
 101       write (iunit,'(a)') 'TER'
 102       do i=nnt,nct-1
 103         if (itype(i).eq.10) then
 104           write (iunit,30) ica(i),ica(i+1)
 105         else
 106           write (iunit,30) ica(i),ica(i+1),ica(i)+1
 107         endif
 108       enddo
 109       if (itype(nct).ne.10) then
 110         write (iunit,30) ica(nct),ica(nct)+1
 111       endif
 112       do i=1,nss
 113         write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
 114       enddo
 115       write (iunit,'(a6)') 'ENDMDL'
 116   10  FORMAT ('ATOM',I7,'  CA  ',A3,I6,4X,3F8.3,f15.3)
 117   20  FORMAT ('ATOM',I7,'  CB  ',A3,I6,4X,3F8.3,f15.3)
 118   30  FORMAT ('CONECT',8I5)
 119       return
 120       end
 121 c------------------------------------------------------------------------------
 122       subroutine MOL2out(etot,tytul)
 123 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
 124 C format.
 125       implicit real*8 (a-h,o-z)
 126       include 'DIMENSIONS'
 127       include 'COMMON.CHAIN'
 128       include 'COMMON.INTERACT'
 129       include 'COMMON.NAMES'
 130       include 'COMMON.IOUNITS'
 131       include 'COMMON.HEADER'
 132       include 'COMMON.SBRIDGE'
 133       character*32 tytul,fd
 134       character*3 zahl
 135       character*6 res_num,pom,ucase
 136 #ifdef AIX
 137       call fdate_(fd)
 138 #elif (defined CRAY)
 139       call date(fd)
 140 #else
 141       call fdate(fd)
 142 #endif
 143       write (imol2,'(a)') '#'
 144       write (imol2,'(a)')
 145      & '#         Creating user name:           unres'
 146       write (imol2,'(2a)') '#         Creation time:                ',
 147      & fd
 148       write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
 149       write (imol2,'(a)') tytul
 150       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
 151       write (imol2,'(a)') 'SMALL'
 152       write (imol2,'(a)') 'USER_CHARGES'
 153       write (imol2,'(a)') '\@<TRIPOS>ATOM'
 154       do i=nnt,nct
 155         write (zahl,'(i3)') i
 156         pom=ucase(restyp(itype(i)))
 157         res_num = pom(:3)//zahl(2:)
 158         write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
 159       enddo
 160       write (imol2,'(a)') '\@<TRIPOS>BOND'
 161       do i=nnt,nct-1
 162         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
 163       enddo
 164       do i=1,nss
 165         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
 166       enddo
 167       write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
 168       do i=nnt,nct
 169         write (zahl,'(i3)') i
 170         pom = ucase(restyp(itype(i)))
 171         res_num = pom(:3)//zahl(2:)
 172         write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
 173       enddo
 174   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
 175   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
 176       return
 177       end
 178 c------------------------------------------------------------------------
 179       subroutine intout
 180       implicit real*8 (a-h,o-z)
 181       include 'DIMENSIONS'
 182       include 'COMMON.IOUNITS'
 183       include 'COMMON.CHAIN'
 184       include 'COMMON.VAR'
 185       include 'COMMON.LOCAL'
 186       include 'COMMON.INTERACT'
 187       include 'COMMON.NAMES'
 188       include 'COMMON.GEO'
 189       write (iout,'(/a)') 'Geometry of the virtual chain.'
 190       write (iout,'(7a)') '  Res  ','         d','     Theta',
 191      & '     Gamma','       Dsc','     Alpha','      Beta '
 192       do i=1,nres
 193         iti=itype(i)
 194         write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
 195      &     rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
 196      &     rad2deg*omeg(i)
 197       enddo
 198       return
 199       end
 200 c---------------------------------------------------------------------------
 201       subroutine briefout(it,ener)
 202       implicit real*8 (a-h,o-z)
 203       include 'DIMENSIONS'
 204       include 'COMMON.IOUNITS'
 205       include 'COMMON.CHAIN'
 206       include 'COMMON.VAR'
 207       include 'COMMON.LOCAL'
 208       include 'COMMON.INTERACT'
 209       include 'COMMON.NAMES'
 210       include 'COMMON.GEO'
 211       include 'COMMON.SBRIDGE'
 212 c     print '(a,i5)',intname,igeom
 213 #if defined(AIX) || defined(PGI)
 214       open (igeom,file=intname,position='append')
 215 #else
 216       open (igeom,file=intname,access='append')
 217 #endif
 218       IF (NSS.LE.9) THEN
 219         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 220       ELSE
 221         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
 222         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
 223       ENDIF
 224 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 225       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 226       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 227 c     if (nvar.gt.nphi+ntheta) then
 228         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 229         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 230 c     endif
 231       close(igeom)
 232   180 format (I5,F12.3,I2,9(1X,2I3))
 233   190 format (3X,11(1X,2I3))
 234   200 format (8F10.4)
 235       return
 236       end
 237 #ifdef WINIFL
 238       subroutine fdate(fd)
 239       character*32 fd
 240       write(fd,'(32x)')
 241       return
 242       end
 243 #endif
 244 c-----------------------------------------------------------------
 245       subroutine statout(itime)
 246       implicit real*8 (a-h,o-z)
 247       include 'DIMENSIONS'
 248       include 'COMMON.CONTROL'
 249       include 'COMMON.CHAIN'
 250       include 'COMMON.INTERACT'
 251       include 'COMMON.NAMES'
 252       include 'COMMON.IOUNITS'
 253       include 'COMMON.HEADER'
 254       include 'COMMON.SBRIDGE'
 255       include 'COMMON.DISTFIT'
 256       include 'COMMON.MD_'
 257 c      include 'COMMON.REMD'
 258       include 'COMMON.SETUP'
 259       integer itime
 260       double precision energia(0:n_ene)
 261       double precision gyrate
 262       external gyrate
 263       common /gucio/ cm
 264       character*256 line1,line2
 265       character*4 format1,format2
 266       character*30 format
 267 #ifdef AIX
 268       if(itime.eq.0) then
 269        open(istat,file=statname,position="append")
 270       endif
 271 #else
 272 #ifdef PGI
 273       open(istat,file=statname,position="append")
 274 #else
 275       open(istat,file=statname,access="append")
 276 #endif
 277 #endif
 278        if (refstr) then
 279 c         call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
 280           write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
 281      &          itime,totT,EK,potE,totE,
 282      &          rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
 283           format1="a133"
 284         else
 285           write (line1,'(i10,f15.2,7f12.3,i5,$)')
 286      &           itime,totT,EK,potE,totE,
 287      &           amax,kinetic_T,t_bath,gyrate(),me
 288           format1="a114"
 289         endif
 290         if(usampl.and.totT.gt.eq_time) then
 291            write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
 292      &      (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
 293      &      (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
 294            write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
 295      &             +21*nfrag_back
 296         elseif(hremd.gt.0) then
 297            write(line2,'(i5)') iset
 298            format2="a005"
 299         else
 300            format2="a001"
 301            line2=' '
 302         endif
 303         if (print_compon) then
 304           write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
 305      &                                                     ",20f12.3)"
 306           write (istat,format) line1,line2,
 307      &      (potEcomp(print_order(i)),i=1,nprint_ene)
 308         else
 309           write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
 310           write (istat,format) line1,line2
 311         endif
 312 #if defined(AIX)
 313         call flush(istat)
 314 #else
 315         close(istat)
 316 #endif
 317        return
 318       end
 319 c---------------------------------------------------------------
 320       double precision function gyrate()
 321       implicit real*8 (a-h,o-z)
 322       include 'DIMENSIONS'
 323       include 'COMMON.INTERACT'
 324       include 'COMMON.CHAIN'
 325       double precision cen(3),rg
 326
 327       do j=1,3
 328        cen(j)=0.0d0
 329       enddo
 330
 331       do i=nnt,nct
 332           do j=1,3
 333             cen(j)=cen(j)+c(j,i)
 334           enddo
 335       enddo
 336       do j=1,3
 337             cen(j)=cen(j)/dble(nct-nnt+1)
 338       enddo
 339       rg = 0.0d0
 340       do i = nnt, nct
 341         do j=1,3
 342          rg = rg + (c(j,i)-cen(j))**2
 343         enddo
 344       end do
 345       gyrate = sqrt(rg/dble(nct-nnt+1))
 346       return
 347       end
 348