Merge branch 'devel' of mmka.chem.univ.gda.pl:unres into devel
[unres.git] / source / wham / src-M / geomout.F
1       subroutine pdbout(ii,temp,efree,etot,entropy,rmsdev)
2       implicit real*8 (a-h,o-z)
3       include 'DIMENSIONS'
4       include 'DIMENSIONS.ZSCOPT'
5       include 'COMMON.CHAIN'
6       include 'COMMON.INTERACT'
7       include 'COMMON.NAMES'
8       include 'COMMON.IOUNITS'
9       include 'COMMON.HEADER'
10       include 'COMMON.SBRIDGE'
11       character*50 tytul
12       character*1 chainid(10) /'A','B','C','D','E','F','G','H','I','J'/
13       dimension ica(maxres)
14       write(ipdb,'("REMARK CONF",i8," TEMPERATURE",f7.1," RMS",0pf7.2)') 
15      &  ii,temp,rmsdev
16       write (ipdb,'("REMARK DIMENSIONLESS FREE ENERGY",1pe15.5)') 
17      &  efree
18       write (ipdb,'("REMARK ENERGY",1pe15.5," ENTROPY",1pe15.5)') 
19      &  etot,entropy
20       iatom=0
21       ichain=1
22       ires=0
23       do i=nnt,nct
24         iti=itype(i)
25         if (iti.eq.21) then
26           ichain=ichain+1
27           ires=0
28           write (ipdb,'(a)') 'TER'
29         else
30         ires=ires+1
31         iatom=iatom+1
32         ica(i)=iatom
33         write (ipdb,10) iatom,restyp(iti),chainid(ichain),
34      &     ires,(c(j,i),j=1,3)
35         if (iti.ne.10) then
36           iatom=iatom+1
37           write (ipdb,20) iatom,restyp(iti),chainid(ichain),
38      &      ires,(c(j,nres+i),j=1,3)
39         endif
40         endif
41       enddo
42       write (ipdb,'(a)') 'TER'
43       do i=nnt,nct-1
44         if (itype(i).eq.21) cycle
45         if (itype(i).eq.10 .and. itype(i+1).ne.21) then
46           write (ipdb,30) ica(i),ica(i+1)
47         else if (itype(i).ne.10 .and. itype(i+1).ne.21) then
48           write (ipdb,30) ica(i),ica(i+1),ica(i)+1
49         else if (itype(i).ne.10 .and. itype(i+1).eq.21) then
50           write (ipdb,30) ica(i),ica(i)+1
51         endif
52       enddo
53       if (itype(nct).ne.10) then
54         write (ipdb,30) ica(nct),ica(nct)+1
55       endif
56       do i=1,nss
57         write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1
58       enddo
59       write (ipdb,'(a6)') 'ENDMDL'
60   10  FORMAT ('ATOM',I7,'  CA  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
61   20  FORMAT ('ATOM',I7,'  CB  ',A3,1X,A1,I4,4X,3F8.3,f15.3)
62   30  FORMAT ('CONECT',8I5)
63       return
64       end
65 c------------------------------------------------------------------------------
66       subroutine MOL2out(etot,tytul)
67 C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 
68 C format.
69       implicit real*8 (a-h,o-z)
70       include 'DIMENSIONS'
71       include 'DIMENSIONS.ZSCOPT'
72       include 'COMMON.CHAIN'
73       include 'COMMON.INTERACT'
74       include 'COMMON.NAMES'
75       include 'COMMON.IOUNITS'
76       include 'COMMON.HEADER'
77       include 'COMMON.SBRIDGE'
78       character*32 tytul,fd
79       character*3 liczba
80       character*6 res_num,pom,ucase
81 #ifdef AIX
82       call fdate_(fd)
83 #else
84       call fdate(fd)
85 #endif
86       write (imol2,'(a)') '#'
87       write (imol2,'(a)') 
88      & '#         Creating user name:           unres'
89       write (imol2,'(2a)') '#         Creation time:                ',
90      & fd
91       write (imol2,'(/a)') '\@<TRIPOS>MOLECULE'
92       write (imol2,'(a)') tytul
93       write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0
94       write (imol2,'(a)') 'SMALL'
95       write (imol2,'(a)') 'USER_CHARGES'
96       write (imol2,'(a)') '\@<TRIPOS>ATOM' 
97       do i=nnt,nct
98         write (liczba,*) i
99         pom=ucase(restyp(itype(i)))
100         res_num = pom(:3)//liczba(2:)
101         write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0
102       enddo
103       write (imol2,'(a)') '\@<TRIPOS>BOND'
104       do i=nnt,nct-1
105         write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1
106       enddo
107       do i=1,nss
108         write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1
109       enddo
110       write (imol2,'(a)') '\@<TRIPOS>SUBSTRUCTURE'
111       do i=nnt,nct
112         write (liczba,*) i
113         pom = ucase(restyp(itype(i)))
114         res_num = pom(:3)//liczba(2:)
115         write (imol2,30) i-nnt+1,res_num,i-nnt+1,0
116       enddo
117   10  FORMAT (I7,' CA      ',3F10.4,' C.3',I8,1X,A,F11.4,' ****')
118   30  FORMAT (I7,1x,A,I14,' RESIDUE',I13,' ****  ****')
119       return
120       end
121 c------------------------------------------------------------------------
122       subroutine intout
123       implicit real*8 (a-h,o-z)
124       include 'DIMENSIONS'
125       include 'DIMENSIONS.ZSCOPT'
126       include 'COMMON.IOUNITS'
127       include 'COMMON.CHAIN'
128       include 'COMMON.VAR'
129       include 'COMMON.LOCAL'
130       include 'COMMON.INTERACT'
131       include 'COMMON.NAMES'
132       include 'COMMON.GEO'
133       write (iout,'(/a)') 'Geometry of the virtual chain.'
134       write (iout,'(7a)') '  Res  ','      Dpep','     Theta',
135      & '       Phi','       Dsc','     Alpha','      Omega'
136       do i=1,nres
137         iti=itype(i)
138         write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i+1),
139      &     rad2deg*theta(i),
140      &     rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i),rad2deg*omeg(i)
141       enddo
142       return
143       end
144 c---------------------------------------------------------------------------
145       subroutine briefout(it,ener)
146       implicit real*8 (a-h,o-z)
147       include 'DIMENSIONS'
148       include 'DIMENSIONS.ZSCOPT'
149       include 'COMMON.IOUNITS'
150       include 'COMMON.CHAIN'
151       include 'COMMON.VAR'
152       include 'COMMON.LOCAL'
153       include 'COMMON.INTERACT'
154       include 'COMMON.NAMES'
155       include 'COMMON.GEO'
156       include 'COMMON.SBRIDGE'
157       print '(a,i5)',intname,igeom
158 #if defined(AIX) || defined(PGI)
159       open (igeom,file=intname,position='append')
160 #else
161       open (igeom,file=intname,access='append')
162 #endif
163       iii=igeom
164       igeom=iout
165       IF (NSS.LE.9) THEN
166         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS)
167       ELSE
168         WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9)
169         WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS)
170       ENDIF
171 c     IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
172       WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES)
173       WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES)
174 c     if (nvar.gt.nphi+ntheta) then
175         write (igeom,200) (rad2deg*alph(i),i=2,nres-1)
176         write (igeom,200) (rad2deg*omeg(i),i=2,nres-1)
177 c     endif
178       close(igeom)
179   180 format (I5,F12.3,I2,9(1X,2I3))
180   190 format (3X,11(1X,2I3))
181   200 format (8F10.4)
182       return
183       end