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