1 subroutine pdbout(etot,tytul,iunit)
2 implicit real*8 (a-h,o-z)
5 include 'COMMON.INTERACT'
7 include 'COMMON.IOUNITS'
8 include 'COMMON.HEADER'
9 include 'COMMON.SBRIDGE'
10 c include 'COMMON.DISTFIT'
13 character*1 chainid(26) /'A','B','C','D','E','F','G','H','I','J',
14 & 'K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/
16 write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot
17 cmodel write (iunit,'(a5,i6)') 'MODEL',1
18 c if (nhfrag.gt.0) then
20 c iti=itype(hfrag(1,j))
21 c itj=itype(hfrag(2,j))
23 c write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)')
25 c & restyp(iti),hfrag(1,j)-1,
26 c & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
28 c write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)')
30 c & restyp(iti),hfrag(1,j)-1,
31 c & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j)
36 c if (nbfrag.gt.0) then
40 c iti=itype(bfrag(1,j))
41 c itj=itype(bfrag(2,j)-1)
43 c write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)')
44 c & 'SHEET',1,'B',j,2,
45 c & restyp(iti),bfrag(1,j)-1,
46 c & restyp(itj),bfrag(2,j)-2,0
48 c if (bfrag(3,j).gt.bfrag(4,j)) then
50 c itk=itype(bfrag(3,j))
51 c itl=itype(bfrag(4,j)+1)
53 c write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
54 c & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
55 c & 'SHEET',2,'B',j,2,
56 c & restyp(itl),bfrag(4,j),
57 c & restyp(itk),bfrag(3,j)-1,-1,
58 c & "N",restyp(itk),bfrag(3,j)-1,
59 c & "O",restyp(iti),bfrag(1,j)-1
63 c itk=itype(bfrag(3,j))
64 c itl=itype(bfrag(4,j)-1)
67 c write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3,
68 c & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)')
69 c & 'SHEET',2,'B',j,2,
70 c & restyp(itk),bfrag(3,j)-1,
71 c & restyp(itl),bfrag(4,j)-2,1,
72 c & "N",restyp(itk),bfrag(3,j)-1,
73 c & "O",restyp(iti),bfrag(1,j)-1
84 write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)')
85 & 'SSBOND',i,'CYS',ihpb(i)-1-nres,
86 & 'CYS',jhpb(i)-1-nres
98 if (iti.eq.ntyp1) then
101 if (iti_prev.ne.ntyp1) write (iunit,'(a)') 'TER'
106 write (iunit,10) iatom,restyp(iti),chainid(1+mod(ichain/2,26)),
107 & ires,(c(j,i),j=1,3)!,vtot(i)
110 write (iunit,20) iatom,restyp(iti),
111 & chainid(1+mod(ichain/2,26)),ires,(c(j,nres+i),j=1,3)
118 write (iunit,'(a)') 'TER'
120 if (itype(i).eq.ntyp1) cycle
121 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
122 write (iunit,30) ica(i),ica(i+1)
123 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) 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.ntyp1) then
126 write (iunit,30) ica(i),ica(i)+1
129 if (itype(nct).ne.10) then
130 write (iunit,30) ica(nct),ica(nct)+1
133 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
135 write (iunit,'(a6)') 'ENDMDL'
136 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
137 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
138 30 FORMAT ('CONECT',8I5)
141 c------------------------------------------------------------------------------
142 subroutine MOL2out(etot,tytul)
143 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
145 implicit real*8 (a-h,o-z)
147 include 'COMMON.CHAIN'
148 include 'COMMON.INTERACT'
149 include 'COMMON.NAMES'
150 include 'COMMON.IOUNITS'
151 include 'COMMON.HEADER'
152 include 'COMMON.SBRIDGE'
153 character*32 tytul,fd
155 character*6 res_num,pom,ucase
163 write (imol2,'(a)') '#'
165 & '# Creating user name: unres'
166 write (imol2,'(2a)') '# Creation time: ',
168 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
169 write (imol2,'(a)') tytul
170 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
171 write (imol2,'(a)') 'SMALL'
172 write (imol2,'(a)') 'USER_CHARGES'
173 write (imol2,'(a)') '\@<TRIPOS>ATOM'
175 write (liczba,'(i3)') i
176 pom=ucase(restyp(itype(i)))
177 res_num = pom(:3)//liczba(2:)
178 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
180 write (imol2,'(a)') '\@<TRIPOS>BOND'
182 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
185 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
187 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
189 write (liczba,'(i3)') i
190 pom = ucase(restyp(itype(i)))
191 res_num = pom(:3)//liczba(2:)
192 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
194 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
195 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
198 c------------------------------------------------------------------------
199 subroutine briefout(it,ener)
200 implicit real*8 (a-h,o-z)
202 include 'COMMON.IOUNITS'
203 include 'COMMON.CHAIN'
205 include 'COMMON.LOCAL'
206 include 'COMMON.INTERACT'
207 include 'COMMON.NAMES'
209 include 'COMMON.SBRIDGE'
210 c print '(a,i5)',intname,igeom
211 #if defined(AIX) || defined(PGI)
212 open (igeom,file=intname,position='append')
214 open (igeom,file=intname,access='append')
217 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
219 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
220 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
222 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
223 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
224 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
225 c if (nvar.gt.nphi+ntheta) then
226 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
227 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
230 180 format (I5,F12.3,I2,9(1X,2I3))
231 190 format (3X,11(1X,2I3))
242 c----------------------------------------------------------------
243 subroutine cartoutx(time,nfrag,qfrag)
244 implicit real*8 (a-h,o-z)
246 include 'COMMON.CHAIN'
247 include 'COMMON.INTERACT'
248 include 'COMMON.NAMES'
249 include 'COMMON.IOUNITS'
250 include 'COMMON.HEADER'
251 include 'COMMON.SBRIDGE'
252 include 'COMMON.DISTFIT'
253 c include 'COMMON.MD'
254 double precision time
255 double precision qfrag(100)
256 #if defined(AIX) || defined(PGI)
257 open(icart,file=cartname,position="append")
259 open(icart,file=cartname,access="append")
261 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
262 write (icart,'(i4,$)')
263 & nss,(ihpb(j),jhpb(j),j=1,nss)
264 write (icart,'(i4,20f7.4)') nfrag,
265 & (qfrag(i),i=1,nfrag)
266 write (icart,'(8f10.5)')
267 & ((c(k,j),k=1,3),j=1,nres),
268 & ((c(k,j+nres),k=1,3),j=nnt,nct)
272 c-----------------------------------------------------------------
273 subroutine cartout(time,nfrag,qfrag)
274 implicit real*8 (a-h,o-z)
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 c include 'COMMON.MD'
284 double precision time
286 double precision qfrag(100)
287 real xcoord(3,maxres2+2),prec
289 call xdrfopen(ixdrf,cartname, "w", iret)
290 call xdrffloat(ixdrf, real(time), iret)
291 call xdrffloat(ixdrf, real(potE), iret)
292 call xdrffloat(ixdrf, real(uconst), iret)
293 call xdrffloat(ixdrf, real(t_bath), iret)
294 call xdrfint(ixdrf, nss, iret)
296 call xdrfint(ixdrf, ihpb(j), iret)
297 call xdrfint(ixdrf, jhpb(j), iret)
299 call xdrfint(ixdrf, nfrag, iret)
301 call xdrffloat(ixdrf, real(qfrag(i)), iret)
311 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
316 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
317 call xdrfclose(ixdrf, iret)