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,t76,i5)')
  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       include 'COMMON.TORSION'
 214       write (iout,'(/a)') 'Geometry of the virtual chain.'
 215       write (iout,'(7a)') '  Res  ','         d','     Theta',
 216      & '       Phi','       Dsc','     Alpha','      Omega'
 217       do i=1,nres
 218         iti=itype(i)
 219         write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i),
 220      &     rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),
 221      &     rad2deg*omeg(i)
 222       enddo
 223       return
 224       end
 225 c---------------------------------------------------------------------------
 226       subroutine briefout(it,ener)
 227       implicit real*8 (a-h,o-z)
 228       include 'DIMENSIONS'
 229       include 'COMMON.IOUNITS'
 230       include 'COMMON.CHAIN'
 231       include 'COMMON.VAR'
 232       include 'COMMON.LOCAL'
 233       include 'COMMON.INTERACT'
 234       include 'COMMON.NAMES'
 235       include 'COMMON.GEO'
 236       include 'COMMON.SBRIDGE'
 237 c     print '(a,i5)',intname,igeom
 238 #if defined(AIX) || defined(PGI)
 239       open (igeom,file=intname,position='append')
 240 #else
 241       open (igeom,file=intname,access='append')
 242 #endif
 243       IF (NSS.LE.9) THEN
 244         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
 245       ELSE
 246         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
 247         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
 248       ENDIF
 249 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 250       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
 251       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
 252 c     if (nvar.gt.nphi+ntheta) then
 253         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
 254         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
 255 c     endif
 256       close(igeom)
 257   180 format (I5,F12.3,I2,9(1X,2I3))
 258   190 format (3X,11(1X,2I3))
 259   200 format (8F10.4)
 260       return
 261       end
 262 #ifdef WINIFL
 263       subroutine fdate(fd)
 264       character*32 fd
 265       write(fd,'(32x)')
 266       return
 267       end
 268 #endif
 269 c----------------------------------------------------------------
 270 #ifdef NOXDR
 271       subroutine cartout(time)
 272 #else
 273       subroutine cartoutx(time)
 274 #endif
 275       implicit real*8 (a-h,o-z)
 276       include 'DIMENSIONS'
 277       include 'COMMON.CHAIN'
 278       include 'COMMON.INTERACT'
 279       include 'COMMON.NAMES'
 280       include 'COMMON.IOUNITS'
 281       include 'COMMON.HEADER'
 282       include 'COMMON.SBRIDGE'
 283       include 'COMMON.DISTFIT'
 284       include 'COMMON.MD'
 285       double precision time
 286 #if defined(AIX) || defined(PGI)
 287       open(icart,file=cartname,position="append")
 288 #else
 289       open(icart,file=cartname,access="append")
 290 #endif
 291       write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
 292       if (dyn_ss) then
 293        write (icart,'(i4,$)')
 294      &   nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss)
 295       else
 296        write (icart,'(i4,$)')
 297      &   nss,(ihpb(j),jhpb(j),j=1,nss)
 298        endif
 299        write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back,
 300      & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair),
 301      & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
 302       write (icart,'(8f10.5)')
 303      & ((c(k,j),k=1,3),j=1,nres),
 304      & ((c(k,j+nres),k=1,3),j=nnt,nct)
 305       close(icart)
 306       return
 307       end
 308 c-----------------------------------------------------------------
 309 #ifndef NOXDR
 310       subroutine cartout(time)
 311       implicit real*8 (a-h,o-z)
 312       include 'DIMENSIONS'
 313 #ifdef MPI
 314       include 'mpif.h'
 315       include 'COMMON.SETUP'
 316 #else
 317       parameter (me=0)
 318 #endif
 319       include 'COMMON.CHAIN'
 320       include 'COMMON.INTERACT'
 321       include 'COMMON.NAMES'
 322       include 'COMMON.IOUNITS'
 323       include 'COMMON.HEADER'
 324       include 'COMMON.SBRIDGE'
 325       include 'COMMON.DISTFIT'
 326       include 'COMMON.MD'
 327       double precision time
 328       integer iret,itmp
 329       real xcoord(3,maxres2+2),prec
 330
 331 #ifdef AIX
 332       call xdrfopen_(ixdrf,cartname, "a", iret)
 333       call xdrffloat_(ixdrf, real(time), iret)
 334       call xdrffloat_(ixdrf, real(potE), iret)
 335       call xdrffloat_(ixdrf, real(uconst), iret)
 336       call xdrffloat_(ixdrf, real(uconst_back), iret)
 337       call xdrffloat_(ixdrf, real(t_bath), iret)
 338       call xdrfint_(ixdrf, nss, iret)
 339       do j=1,nss
 340        if (dyn_ss) then
 341         call xdrfint_(ixdrf, idssb(j)+nres, iret)
 342         call xdrfint_(ixdrf, jdssb(j)+nres, iret)
 343        else
 344         call xdrfint_(ixdrf, ihpb(j), iret)
 345         call xdrfint_(ixdrf, jhpb(j), iret)
 346        endif
 347       enddo
 348       call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret)
 349       do i=1,nfrag
 350         call xdrffloat_(ixdrf, real(qfrag(i)), iret)
 351       enddo
 352       do i=1,npair
 353         call xdrffloat_(ixdrf, real(qpair(i)), iret)
 354       enddo
 355       do i=1,nfrag_back
 356         call xdrffloat_(ixdrf, real(utheta(i)), iret)
 357         call xdrffloat_(ixdrf, real(ugamma(i)), iret)
 358         call xdrffloat_(ixdrf, real(uscdiff(i)), iret)
 359       enddo
 360 #else
 361       call xdrfopen(ixdrf,cartname, "a", iret)
 362       call xdrffloat(ixdrf, real(time), iret)
 363       call xdrffloat(ixdrf, real(potE), iret)
 364       call xdrffloat(ixdrf, real(uconst), iret)
 365       call xdrffloat(ixdrf, real(uconst_back), iret)
 366       call xdrffloat(ixdrf, real(t_bath), iret)
 367       call xdrfint(ixdrf, nss, iret)
 368       do j=1,nss
 369        if (dyn_ss) then
 370         call xdrfint(ixdrf, idssb(j)+nres, iret)
 371         call xdrfint(ixdrf, jdssb(j)+nres, iret)
 372        else
 373         call xdrfint(ixdrf, ihpb(j), iret)
 374         call xdrfint(ixdrf, jhpb(j), iret)
 375        endif
 376       enddo
 377       call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret)
 378       do i=1,nfrag
 379         call xdrffloat(ixdrf, real(qfrag(i)), iret)
 380       enddo
 381       do i=1,npair
 382         call xdrffloat(ixdrf, real(qpair(i)), iret)
 383       enddo
 384       do i=1,nfrag_back
 385         call xdrffloat(ixdrf, real(utheta(i)), iret)
 386         call xdrffloat(ixdrf, real(ugamma(i)), iret)
 387         call xdrffloat(ixdrf, real(uscdiff(i)), iret)
 388       enddo
 389 #endif
 390       prec=10000.0
 391       do i=1,nres
 392        do j=1,3
 393         xcoord(j,i)=c(j,i)
 394        enddo
 395       enddo
 396       do i=nnt,nct
 397        do j=1,3
 398         xcoord(j,nres+i-nnt+1)=c(j,i+nres)
 399        enddo
 400       enddo
 401
 402       itmp=nres+nct-nnt+1
 403 #ifdef AIX
 404       call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret)
 405       call xdrfclose_(ixdrf, iret)
 406 #else
 407       call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
 408       call xdrfclose(ixdrf, iret)
 409 #endif
 410       return
 411       end
 412 #endif
 413 c-----------------------------------------------------------------
 414       subroutine statout(itime)
 415       implicit real*8 (a-h,o-z)
 416       include 'DIMENSIONS'
 417       include 'COMMON.CONTROL'
 418       include 'COMMON.CHAIN'
 419       include 'COMMON.INTERACT'
 420       include 'COMMON.NAMES'
 421       include 'COMMON.IOUNITS'
 422       include 'COMMON.HEADER'
 423       include 'COMMON.SBRIDGE'
 424       include 'COMMON.DISTFIT'
 425       include 'COMMON.MD'
 426       include 'COMMON.SETUP'
 427       integer itime
 428       double precision energia(0:n_ene)
 429       double precision gyrate
 430       external gyrate
 431       common /gucio/ cm
 432       character*256 line1,line2
 433       character*4 format1,format2
 434       character*30 format
 435 #ifdef AIX
 436       if(itime.eq.0) then
 437        open(istat,file=statname,position="append")
 438       endif
 439 #else
 440 #ifdef PGI
 441       open(istat,file=statname,position="append")
 442 #else
 443       open(istat,file=statname,access="append")
 444 #endif
 445 #endif
 446        if (refstr) then
 447          call rms_nac_nnc(rms,frac,frac_nn,co,.false.)
 448           write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)')
 449      &          itime,totT,EK,potE,totE,
 450      &          rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me
 451           format1="a133"
 452         else
 453           write (line1,'(i10,f15.2,7f12.3,i5,$)')
 454      &           itime,totT,EK,potE,totE,
 455      &           amax,kinetic_T,t_bath,gyrate(),me
 456           format1="a114"
 457         endif
 458         if(usampl.and.totT.gt.eq_time) then
 459            write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back,
 460      &      (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair),
 461      &      (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back)
 462            write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair
 463      &             +21*nfrag_back
 464         else
 465            format2="a001"
 466            line2=' '
 467         endif
 468         if (print_compon) then
 469           write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2,
 470      &                                                     ",20f12.3)"
 471           write (istat,format) line1,line2,
 472      &      (potEcomp(print_order(i)),i=1,nprint_ene)
 473         else
 474           write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")"
 475           write (istat,format) line1,line2
 476         endif
 477 #if defined(AIX)
 478         call flush(istat)
 479 #else
 480         close(istat)
 481 #endif
 482        return
 483       end
 484 c---------------------------------------------------------------
 485       double precision function gyrate()
 486       implicit real*8 (a-h,o-z)
 487       include 'DIMENSIONS'
 488       include 'COMMON.INTERACT'
 489       include 'COMMON.CHAIN'
 490       double precision cen(3),rg
 491
 492       do j=1,3
 493        cen(j)=0.0d0
 494       enddo
 495
 496       do i=nnt,nct
 497           do j=1,3
 498             cen(j)=cen(j)+c(j,i)
 499           enddo
 500       enddo
 501       do j=1,3
 502             cen(j)=cen(j)/dble(nct-nnt+1)
 503       enddo
 504       rg = 0.0d0
 505       do i = nnt, nct
 506         do j=1,3
 507          rg = rg + (c(j,i)-cen(j))**2
 508         enddo
 509       end do
 510       gyrate = sqrt(rg/dble(nct-nnt+1))
 511       return
 512       end
 513