source/xdrfpdb/src-M/xdrf2pdb-m.F

   1       implicit real*8 (a-h,o-z)
   2       include 'DIMENSIONS'
   3       include 'COMMON.CHAIN'
   4       include 'COMMON.INTERACT'
   5       include 'COMMON.SBRIDGE'
   6       real*4 coord(3,5000)
   7       real*4 prec,time,potE,uconst,t_bath,qfrag(100)
   8       real*8 etot
   9       character*80 arg,seqfile,pdbfile
  10       character*3 sequenc(maxres)
  11       character*50 tytul
  12       character*8 onethree,cfreq,cntraj,citraj
  13       character*8 ucase
  14       external ucase
  15       logical oneletter
  16       integer rescode
  17       external rescode
  18
  19       ifreq=1
  20       if (iargc().lt.3) then
  21         print '(2a)',
  22      &   "Usage: xdrf2pdb-m one/three seqfile cxfile [freq] [pdbfile] ",
  23      &    " [ntraj] [itraj]"
  24         stop
  25       endif
  26       call getarg(1,onethree)
  27       onethree = ucase(onethree)
  28       if (onethree.eq.'ONE') then
  29         oneletter = .true.
  30       else if (onethree.eq.'THREE') then
  31         oneletter = .false.
  32       else
  33         print *,"ONE or THREE must be specified"
  34       endif
  35       call getarg(2,seqfile)
  36       open (1,file=seqfile,status='old')
  37       if (oneletter) then
  38         read(1,'(80a1)',end=10,err=10) (sequenc(i)(1:1),i=1,maxres)
  39    10   continue
  40         nres=i
  41         i=0
  42         do while (.not.iblnk(sequenc(i+1)(1:1)))
  43           i=i+1
  44         enddo
  45         nres=i
  46         do i=1,nres
  47           itype(i)=rescode(i,sequenc(i),1)
  48         enddo
  49       else
  50         read(1,'(20(a3,1x))',end=11,err=11) (sequenc(i),i=1,maxres)
  51    11   continue
  52         nres=i
  53         i=0
  54         do while (.not.iblnk(sequenc(i+1)(1:1)))
  55           i=i+1
  56         enddo
  57         nres=i
  58         do i=1,nres
  59           itype(i)=rescode(i,sequenc(i),0)
  60         enddo
  61         print *,nres
  62         print '(a3,1x)',(sequenc(i),i=1,nres)
  63       endif
  64       call getarg(3,arg)
  65       iext = index(arg,'.cx') - 1
  66       if (iext.lt.0) then
  67         print *,"Error - not a cx file"
  68         stop
  69       endif
  70       if (iargc().gt.3) then
  71         call getarg(4,cfreq)
  72         read (cfreq,*) ifreq
  73       endif
  74       if (iargc().gt.4) then
  75         call getarg(5,pdbfile)
  76       else
  77         pdbfile=arg(:iext)//'.pdb'
  78       endif
  79       if (iargc().gt.5) then
  80         call getarg(6,cntraj)
  81         read (cntraj,*) ntraj
  82       else
  83         ntraj=1
  84       endif
  85       if (iargc().gt.6) then
  86         call getarg(7,citraj)
  87         read (citraj,*) itraj
  88       else
  89         itraj=1
  90       endif
  91       print *,"ifreq",ifreq," ntraj",ntraj," itraj",itraj
  92       open(9,file=pdbfile)
  93       nnt = 1
  94       if (itype(1).eq.21) nnt = 2
  95       nct=nres
  96       if (itype(nres).eq.21) nct = nres-1
  97       print *,"nnt",nnt," nct",nct
  98       call xdrfopen(ixdrf,arg, "r", iret)
  99       kk = 0
 100       do while(.true.)
 101        call xdrffloat(ixdrf, time, iret)
 102        if(iret.eq.0) exit
 103        kk = kk + 1
 104        call xdrffloat(ixdrf, potE, iret)
 105        call xdrffloat(ixdrf, uconst, iret)
 106 #ifdef NEWUNRES
 107        call xdrffloat(ixdrf, uconst_back, iret)
 108 #endif
 109        call xdrffloat(ixdrf, t_bath, iret)
 110        call xdrfint(ixdrf, nss, iret)
 111        do j=1,nss
 112         call xdrfint(ixdrf, ihpb(j), iret)
 113         call xdrfint(ixdrf, jhpb(j), iret)
 114        enddo
 115        call xdrfint(ixdrf, nfrag, iret)
 116        do i=1,nfrag
 117         call xdrffloat(ixdrf, qfrag(i), iret)
 118        enddo
 119        prec=10000.0
 120
 121        isize=0
 122        call xdrf3dfcoord(ixdrf, coord, isize, prec, iret)
 123
 124
 125 c       write (*,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
 126 c       write (*,'(i4,$)') nss,(ihpb(j),jhpb(j),j=1,nss)
 127 c       write (*,'(i4,20f7.4)') nfrag,(qfrag(i),i=1,nfrag)
 128 c       write (*,'(8f10.5)') ((coord(k,j),k=1,3),j=1,isize)
 129        if (mod(kk/ntraj,ifreq).eq.0 .and. mod(kk,ntraj).eq.itraj) then
 130          if (isize .ne. nres+nct-nnt+1) then
 131            print *,"Error: inconsistent sizes",isize,nres+nct-nnt+1
 132          endif
 133          do i=1,nres
 134            do j=1,3
 135              c(j,i)=coord(j,i)
 136            enddo
 137          enddo
 138          ii = 0
 139          do i=nnt,nct
 140            ii = ii + 1
 141            do j=1,3
 142              c(j,i+nres)=coord(j,ii+nres)
 143            enddo
 144          enddo
 145          etot=potE
 146          write (tytul,'(a,i6)') "Structure",kk
 147          call pdbout(etot,tytul,9)
 148        endif
 149       enddo
 150
 151       end