source/unres/src_MD-M/geomout.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       character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
  14       dimension ica(maxres)
  15       write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
  16 cmodel      write (iunit,'(a5,i6)') 'MODEL',1
  17       if (nhfrag.gt.0) then
  18        do j=1,nhfrag
  19         iti=itype(hfrag(1,j))
  20         itj=itype(hfrag(2,j))
  21         if (j.lt.10) then
  22            write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
  23      &           'HELIX',j,'H',j,
  24      &           restyp(iti),hfrag(1,j)-1,
  25      &           restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
  26         else
  27              write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
  28      &           'HELIX',j,'H',j,
  29      &           restyp(iti),hfrag(1,j)-1,
  30      &           restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
  31         endif
  32        enddo
  33       endif
  34
  35       if (nbfrag.gt.0) then
  36
  37        do j=1,nbfrag
  38
  39         iti=itype(bfrag(1,j))
  40         itj=itype(bfrag(2,j)-1)
  41
  42         write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
  43      &           'SHEET',1,'B',j,2,
  44      &           restyp(iti),bfrag(1,j)-1,
  45      &           restyp(itj),bfrag(2,j)-2,0
  46
  47         if (bfrag(3,j).gt.bfrag(4,j)) then
  48
  49          itk=itype(bfrag(3,j))
  50          itl=itype(bfrag(4,j)+1)
  51
  52          write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
  53      &              2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
  54      &           'SHEET',2,'B',j,2,
  55      &           restyp(itl),bfrag(4,j),
  56      &           restyp(itk),bfrag(3,j)-1,-1,
  57      &           "N",restyp(itk),bfrag(3,j)-1,
  58      &           "O",restyp(iti),bfrag(1,j)-1
  59
  60         else
  61
  62          itk=itype(bfrag(3,j))
  63          itl=itype(bfrag(4,j)-1)
  64
  65
  66         write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
  67      &              2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
  68      &           'SHEET',2,'B',j,2,
  69      &           restyp(itk),bfrag(3,j)-1,
  70      &           restyp(itl),bfrag(4,j)-2,1,
  71      &           "N",restyp(itk),bfrag(3,j)-1,
  72      &           "O",restyp(iti),bfrag(1,j)-1
  73
  74
  75
  76         endif
  77
  78        enddo
  79       endif
  80
  81       if (nss.gt.0) then
  82         do i=1,nss
  83          if (dyn_ss) then
  84           write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
  85      &         'SSBOND',i,'CYS',idssb(i)-nnt+1,
  86      &                    'CYS',jdssb(i)-nnt+1
  87          else
  88           write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
  89      &         'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres,
  90      &                    'CYS',jhpb(i)-nnt+1-nres
  91          endif
  92         enddo
  93       endif
  94
  95       iatom=0
  96       ichain=1
  97       ires=0
  98       do i=nnt,nct
  99         iti=itype(i)
 100         if (iti.eq.21) then
 101           ichain=ichain+1
 102           ires=0
 103           write (iunit,'(a)') 'TER'
 104         else
 105         ires=ires+1
 106         iatom=iatom+1
 107         ica(i)=iatom
 108         write (iunit,10) iatom,restyp(iti),chainid(ichain),
 109      &     ires,(c(j,i),j=1,3),vtot(i)
 110         if (iti.ne.10) then
 111           iatom=iatom+1
 112           write (iunit,20) iatom,restyp(iti),chainid(ichain),
 113      &      ires,(c(j,nres+i),j=1,3),
 114      &      vtot(i+nres)
 115         endif
 116         endif
 117       enddo
 118       write (iunit,'(a)') 'TER'
 119       do i=nnt,nct-1
 120         if (itype(i).eq.21) cycle
 121         if (itype(i).eq.10 .and. itype(i+1).ne.21) then
 122           write (iunit,30) ica(i),ica(i+1)
 123         else if (itype(i).ne.10 .and. itype(i+1).ne.21) then
 124           write (iunit,30) ica(i),ica(i+1),ica(i)+1
 125         else if (itype(i).ne.10 .and. itype(i+1).eq.21) then
 126           write (iunit,30) ica(i),ica(i)+1
 127         endif
 128       enddo
 129       if (itype(nct).ne.10) then
 130         write (iunit,30) ica(nct),ica(nct)+1
 131       endif
 132       do i=1,nss
 133        if (dyn_ss) then
 134         write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1
 135        else
 136         write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
 137        endif
 138       enddo
 139       write (iunit,'(a6)') 'ENDMDL'
 140   10  FORMAT ('ATOM',I7,'  CA  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
 141   20  FORMAT ('ATOM',I7,'  CB  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
 142   30  FORMAT ('CONECT',8I5)
 143       return
 144       end
 145 c------------------------------------------------------------------------------
 146       subroutine MOL2out(etot,tytul)
 147 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
 148 C format.
 149       implicit real*8 (a-h,o-z)
 150       include 'DIMENSIONS'
 151       include 'COMMON.CHAIN'
 152       include 'COMMON.INTERACT'
 153       include 'COMMON.NAMES'
 154       include 'COMMON.IOUNITS'
 155       include 'COMMON.HEADER'
 156       include 'COMMON.SBRIDGE'
 157       character*32 tytul,fd
 158       character*3 zahl
 159       character*6 res_num,pom,ucase
 160 #ifdef AIX
 161       call fdate_(fd)
 162 #elif (defined CRAY)
 163       call date(fd)
 164 #else
 165       call fdate(fd)
 166 #endif
 167       write (imol2,'(a)') '#'
 168       write (imol2,'(a)')
 169      & '#         Creating user name:           unres'
 170       write (imol2,'(2a)') '#         Creation time:                ',
 171      & fd
 172       write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
 173       write (imol2,'(a)') tytul
 174       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
 175       write (imol2,'(a)') 'SMALL'
 176       write (imol2,'(a)') 'USER_CHARGES'
 177       write (imol2,'(a)') '\@<TRIPOS>ATOM'
 178       do i=nnt,nct
 179         write (zahl,'(i3)') i
 180         pom=ucase(restyp(itype(i)))
 181         res_num = pom(:3)//zahl(2:)
 182         write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
 183       enddo
 184       write (imol2,'(a)') '\@<TRIPOS>BOND'
 185       do i=nnt,nct-1
 186         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
 187       enddo
 188       do i=1,nss
 189         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
 190       enddo
 191       write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
 192       do i=nnt,nct
 193         write (zahl,'(i3)') i
 194         pom = ucase(restyp(itype(i)))
 195         res_num = pom(:3)//zahl(2:)
 196         write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
 197       enddo
 198   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
 199   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
 200       return
 201       end
 202 c------------------------------------------------------------------------
 203       subroutine intout
 204       implicit real*8 (a-h,o-z)
 205       include 'DIMENSIONS'
 206       include 'COMMON.IOUNITS'
 207       include 'COMMON.CHAIN'
 208       include 'COMMON.VAR'
 209       include 'COMMON.LOCAL'
 210       include 'COMMON.INTERACT'
 211       include 'COMMON.NAMES'
 212       include 'COMMON.GEO'
 213       write (iout,'(/a)') 'Geometry of the virtual chain.'
 214       write (iout,'(7a)') '  Res  ','         d','     Theta',
 215      & '       Phi','       Dsc','     Alpha','      Omega'
 216       do i=1,nres
 217         iti=itype(i)
 218         write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
 219      &     rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
 220      &     rad2deg*omeg(i)
 221       enddo
 222       return
 223       end
 224 c---------------------------------------------------------------------------
 225       subroutine briefout(it,ener)
 226       implicit real*8 (a-h,o-z)
 227       include 'DIMENSIONS'
 228       include 'COMMON.IOUNITS'
 229       include 'COMMON.CHAIN'
 230       include 'COMMON.VAR'
 231       include 'COMMON.LOCAL'
 232       include 'COMMON.INTERACT'
 233       include 'COMMON.NAMES'
 234       include 'COMMON.GEO'
 235       include 'COMMON.SBRIDGE'
 236 c     print '(a,i5)',intname,igeom
 237 #if defined(AIX) || defined(PGI)
 238       open (igeom,file=intname,position='append')
 239 #else
 240       open (igeom,file=intname,access='append')
 241 #endif
 242       IF (NSS.LE.9) THEN
 243         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 244       ELSE
 245         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
 246         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
 247       ENDIF
 248 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 249       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 250       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 251 c     if (nvar.gt.nphi+ntheta) then
 252         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 253         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 254 c     endif
 255       close(igeom)
 256   180 format (I5,F12.3,I2,9(1X,2I3))
 257   190 format (3X,11(1X,2I3))
 258   200 format (8F10.4)
 259       return
 260       end
 261 #ifdef WINIFL
 262       subroutine fdate(fd)
 263       character*32 fd
 264       write(fd,'(32x)')
 265       return
 266       end
 267 #endif
 268 c----------------------------------------------------------------
 269 #ifdef NOXDR
 270       subroutine cartout(time)
 271 #else
 272       subroutine cartoutx(time)
 273 #endif
 274       implicit real*8 (a-h,o-z)
 275       include 'DIMENSIONS'
 276       include 'COMMON.CHAIN'
 277       include 'COMMON.INTERACT'
 278       include 'COMMON.NAMES'
 279       include 'COMMON.IOUNITS'
 280       include 'COMMON.HEADER'
 281       include 'COMMON.SBRIDGE'
 282       include 'COMMON.DISTFIT'
 283       include 'COMMON.MD'
 284       double precision time
 285 #if defined(AIX) || defined(PGI)
 286       open(icart,file=cartname,position="append")
 287 #else
 288       open(icart,file=cartname,access="append")
 289 #endif
 290       write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
 291       if (dyn_ss) then
 292        write (icart,'(i4,$)')
 293      &   nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
 294       else
 295        write (icart,'(i4,$)')
 296      &   nss,(ihpb(j),jhpb(j),j=1,nss)
 297        endif
 298        write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
 299      & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
 300      & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
 301       write (icart,'(8f10.5)')
 302      & ((c(k,j),k=1,3),j=1,nres),
 303      & ((c(k,j+nres),k=1,3),j=nnt,nct)
 304       close(icart)
 305       return
 306       end
 307 c-----------------------------------------------------------------
 308 #ifndef NOXDR
 309       subroutine cartout(time)
 310       implicit real*8 (a-h,o-z)
 311       include 'DIMENSIONS'
 312 #ifdef MPI
 313       include 'mpif.h'
 314       include 'COMMON.SETUP'
 315 #else
 316       parameter (me=0)
 317 #endif
 318       include 'COMMON.CHAIN'
 319       include 'COMMON.INTERACT'
 320       include 'COMMON.NAMES'
 321       include 'COMMON.IOUNITS'
 322       include 'COMMON.HEADER'
 323       include 'COMMON.SBRIDGE'
 324       include 'COMMON.DISTFIT'
 325       include 'COMMON.MD'
 326       double precision time
 327       integer iret,itmp
 328       real xcoord(3,maxres2+2),prec
 329
 330 #ifdef AIX
 331       call xdrfopen_(ixdrf,cartname, "a", iret)
 332       call xdrffloat_(ixdrf, real(time), iret)
 333       call xdrffloat_(ixdrf, real(potE), iret)
 334       call xdrffloat_(ixdrf, real(uconst), iret)
 335       call xdrffloat_(ixdrf, real(uconst_back), iret)
 336       call xdrffloat_(ixdrf, real(t_bath), iret)
 337       call xdrfint_(ixdrf, nss, iret)
 338       do j=1,nss
 339        if (dyn_ss) then
 340         call xdrfint_(ixdrf, idssb(j)+nres, iret)
 341         call xdrfint_(ixdrf, jdssb(j)+nres, iret)
 342        else
 343         call xdrfint_(ixdrf, ihpb(j), iret)
 344         call xdrfint_(ixdrf, jhpb(j), iret)
 345        endif
 346       enddo
 347       call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
 348       do i=1,nfrag
 349         call xdrffloat_(ixdrf, real(qfrag(i)), iret)
 350       enddo
 351       do i=1,npair
 352         call xdrffloat_(ixdrf, real(qpair(i)), iret)
 353       enddo
 354       do i=1,nfrag_back
 355         call xdrffloat_(ixdrf, real(utheta(i)), iret)
 356         call xdrffloat_(ixdrf, real(ugamma(i)), iret)
 357         call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
 358       enddo
 359 #else
 360       call xdrfopen(ixdrf,cartname, "a", iret)
 361       call xdrffloat(ixdrf, real(time), iret)
 362       call xdrffloat(ixdrf, real(potE), iret)
 363       call xdrffloat(ixdrf, real(uconst), iret)
 364       call xdrffloat(ixdrf, real(uconst_back), iret)
 365       call xdrffloat(ixdrf, real(t_bath), iret)
 366       call xdrfint(ixdrf, nss, iret)
 367       do j=1,nss
 368        if (dyn_ss) then
 369         call xdrfint(ixdrf, idssb(j)+nres, iret)
 370         call xdrfint(ixdrf, jdssb(j)+nres, iret)
 371        else
 372         call xdrfint(ixdrf, ihpb(j), iret)
 373         call xdrfint(ixdrf, jhpb(j), iret)
 374        endif
 375       enddo
 376       call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
 377       do i=1,nfrag
 378         call xdrffloat(ixdrf, real(qfrag(i)), iret)
 379       enddo
 380       do i=1,npair
 381         call xdrffloat(ixdrf, real(qpair(i)), iret)
 382       enddo
 383       do i=1,nfrag_back
 384         call xdrffloat(ixdrf, real(utheta(i)), iret)
 385         call xdrffloat(ixdrf, real(ugamma(i)), iret)
 386         call xdrffloat(ixdrf, real(uscdiff(i)), iret)
 387       enddo
 388 #endif
 389       prec=10000.0
 390       do i=1,nres
 391        do j=1,3
 392         xcoord(j,i)=c(j,i)
 393        enddo
 394       enddo
 395       do i=nnt,nct
 396        do j=1,3
 397         xcoord(j,nres+i-nnt+1)=c(j,i+nres)
 398        enddo
 399       enddo
 400
 401       itmp=nres+nct-nnt+1
 402 #ifdef AIX
 403       call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
 404       call xdrfclose_(ixdrf, iret)
 405 #else
 406       call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
 407       call xdrfclose(ixdrf, iret)
 408 #endif
 409       return
 410       end
 411 #endif
 412 c-----------------------------------------------------------------
 413       subroutine statout(itime)
 414       implicit real*8 (a-h,o-z)
 415       include 'DIMENSIONS'
 416       include 'COMMON.CONTROL'
 417       include 'COMMON.CHAIN'
 418       include 'COMMON.INTERACT'
 419       include 'COMMON.NAMES'
 420       include 'COMMON.IOUNITS'
 421       include 'COMMON.HEADER'
 422       include 'COMMON.SBRIDGE'
 423       include 'COMMON.DISTFIT'
 424       include 'COMMON.MD'
 425       include 'COMMON.SETUP'
 426       integer itime
 427       double precision energia(0:n_ene)
 428       double precision gyrate
 429       external gyrate
 430       common /gucio/ cm
 431       character*256 line1,line2
 432       character*4 format1,format2
 433       character*30 format
 434 #ifdef AIX
 435       if(itime.eq.0) then
 436        open(istat,file=statname,position="append")
 437       endif
 438 #else
 439 #ifdef PGI
 440       open(istat,file=statname,position="append")
 441 #else
 442       open(istat,file=statname,access="append")
 443 #endif
 444 #endif
 445        if (refstr) then
 446          call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
 447           write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
 448      &          itime,totT,EK,potE,totE,
 449      &          rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
 450           format1="a133"
 451         else
 452           write (line1,'(i10,f15.2,7f12.3,i5,$)')
 453      &           itime,totT,EK,potE,totE,
 454      &           amax,kinetic_T,t_bath,gyrate(),me
 455           format1="a114"
 456         endif
 457         if(usampl.and.totT.gt.eq_time) then
 458            write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
 459      &      (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
 460      &      (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
 461            write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
 462      &             +21*nfrag_back
 463         else
 464            format2="a001"
 465            line2=' '
 466         endif
 467         if (print_compon) then
 468           write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
 469      &                                                     ",20f12.3)"
 470           write (istat,format) line1,line2,
 471      &      (potEcomp(print_order(i)),i=1,nprint_ene)
 472         else
 473           write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
 474           write (istat,format) line1,line2
 475         endif
 476 #if defined(AIX)
 477         call flush(istat)
 478 #else
 479         close(istat)
 480 #endif
 481        return
 482       end
 483 c---------------------------------------------------------------
 484       double precision function gyrate()
 485       implicit real*8 (a-h,o-z)
 486       include 'DIMENSIONS'
 487       include 'COMMON.INTERACT'
 488       include 'COMMON.CHAIN'
 489       double precision cen(3),rg
 490
 491       do j=1,3
 492        cen(j)=0.0d0
 493       enddo
 494
 495       do i=nnt,nct
 496           do j=1,3
 497             cen(j)=cen(j)+c(j,i)
 498           enddo
 499       enddo
 500       do j=1,3
 501             cen(j)=cen(j)/dble(nct-nnt+1)
 502       enddo
 503       rg = 0.0d0
 504       do i = nnt, nct
 505         do j=1,3
 506          rg = rg + (c(j,i)-cen(j))**2
 507         enddo
 508       end do
 509       gyrate = sqrt(rg/dble(nct-nnt+1))
 510       return
 511       end
 512