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 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)
117 write (iunit,'(a)') 'TER'
119 if (itype(i).eq.ntyp1) cycle
120 if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then
121 write (iunit,30) ica(i),ica(i+1)
122 else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then
123 write (iunit,30) ica(i),ica(i+1),ica(i)+1
124 else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then
125 write (iunit,30) ica(i),ica(i)+1
128 if (itype(nct).ne.10) then
129 write (iunit,30) ica(nct),ica(nct)+1
132 write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
134 write (iunit,'(a6)') 'ENDMDL'
135 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3)
136 20 FORMAT ('ATOM',I7,' CB ',A3,1X,A1,I4,4X,3F8.3,f15.3)
137 30 FORMAT ('CONECT',8I5)
140 c------------------------------------------------------------------------------
141 subroutine MOL2out(etot,tytul)
142 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2
144 implicit real*8 (a-h,o-z)
146 include 'COMMON.CHAIN'
147 include 'COMMON.INTERACT'
148 include 'COMMON.NAMES'
149 include 'COMMON.IOUNITS'
150 include 'COMMON.HEADER'
151 include 'COMMON.SBRIDGE'
152 character*32 tytul,fd
154 character*6 res_num,pom,ucase
162 write (imol2,'(a)') '#'
164 & '# Creating user name: unres'
165 write (imol2,'(2a)') '# Creation time: ',
167 write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
168 write (imol2,'(a)') tytul
169 write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
170 write (imol2,'(a)') 'SMALL'
171 write (imol2,'(a)') 'USER_CHARGES'
172 write (imol2,'(a)') '\@<TRIPOS>ATOM'
174 write (liczba,'(i3)') i
175 pom=ucase(restyp(itype(i)))
176 res_num = pom(:3)//liczba(2:)
177 write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
179 write (imol2,'(a)') '\@<TRIPOS>BOND'
181 write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
184 write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
186 write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
188 write (liczba,'(i3)') i
189 pom = ucase(restyp(itype(i)))
190 res_num = pom(:3)//liczba(2:)
191 write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
193 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
194 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****')
197 c------------------------------------------------------------------------
198 subroutine briefout(it,ener)
199 implicit real*8 (a-h,o-z)
201 include 'COMMON.IOUNITS'
202 include 'COMMON.CHAIN'
204 include 'COMMON.LOCAL'
205 include 'COMMON.INTERACT'
206 include 'COMMON.NAMES'
208 include 'COMMON.SBRIDGE'
209 c print '(a,i5)',intname,igeom
210 #if defined(AIX) || defined(PGI)
211 open (igeom,file=intname,position='append')
213 open (igeom,file=intname,access='append')
216 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
218 WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
219 WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
221 c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
222 WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
223 WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
224 c if (nvar.gt.nphi+ntheta) then
225 write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
226 write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
229 180 format (I5,F12.3,I2,9(1X,2I3))
230 190 format (3X,11(1X,2I3))
241 c----------------------------------------------------------------
242 subroutine cartoutx(time,nfrag,qfrag)
243 implicit real*8 (a-h,o-z)
245 include 'COMMON.CHAIN'
246 include 'COMMON.INTERACT'
247 include 'COMMON.NAMES'
248 include 'COMMON.IOUNITS'
249 include 'COMMON.HEADER'
250 include 'COMMON.SBRIDGE'
251 include 'COMMON.DISTFIT'
252 c include 'COMMON.MD'
253 double precision time
254 double precision qfrag(100)
255 #if defined(AIX) || defined(PGI)
256 open(icart,file=cartname,position="append")
258 open(icart,file=cartname,access="append")
260 write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath
261 write (icart,'(i4,$)')
262 & nss,(ihpb(j),jhpb(j),j=1,nss)
263 write (icart,'(i4,20f7.4)') nfrag,
264 & (qfrag(i),i=1,nfrag)
265 write (icart,'(8f10.5)')
266 & ((c(k,j),k=1,3),j=1,nres),
267 & ((c(k,j+nres),k=1,3),j=nnt,nct)
271 c-----------------------------------------------------------------
272 subroutine cartout(time,nfrag,qfrag)
273 implicit real*8 (a-h,o-z)
275 include 'COMMON.CHAIN'
276 include 'COMMON.INTERACT'
277 include 'COMMON.NAMES'
278 include 'COMMON.IOUNITS'
279 include 'COMMON.HEADER'
280 include 'COMMON.SBRIDGE'
281 include 'COMMON.DISTFIT'
282 c include 'COMMON.MD'
283 double precision time
285 double precision qfrag(100)
286 real xcoord(3,maxres2+2),prec
288 call xdrfopen(ixdrf,cartname, "w", iret)
289 call xdrffloat(ixdrf, real(time), iret)
290 call xdrffloat(ixdrf, real(potE), iret)
291 call xdrffloat(ixdrf, real(uconst), iret)
292 call xdrffloat(ixdrf, real(t_bath), iret)
293 call xdrfint(ixdrf, nss, iret)
295 call xdrfint(ixdrf, ihpb(j), iret)
296 call xdrfint(ixdrf, jhpb(j), iret)
298 call xdrfint(ixdrf, nfrag, iret)
300 call xdrffloat(ixdrf, real(qfrag(i)), iret)
310 xcoord(j,nres+i-nnt+1)=c(j,i+nres)
315 call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret)
316 call xdrfclose(ixdrf, iret)