-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmod_pdb.f90
137 lines (100 loc) · 3.6 KB
/
mod_pdb.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
module mod_pdb
!
! Created by Veselin Kolev <vesso.kolev@gmail.com>
! 20151013071325
!
use mod_t
character(len=26) :: cryst1fmt="(A6,3F9.3,3F7.2,1X,A11,I4)"
character(len=56) :: atomfmt="(A6,I5,1X,A4,A1,A3,1X,A1,I4,A1,3X,3F8.3,2F6.2,6X,A4,2A2)"
contains
subroutine saveAtomsOnPDB(atoms,inputfile,outputfile)
type(atom_t), dimension(:), intent(in) :: atoms
character(len=*), intent(in) :: inputfile
character(len=*), intent(in) :: outputfile
type(pdb_cryst1_t) :: pdbcryst1
type(pdb_atom_t), dimension(:), allocatable :: pdbatoms
integer(kind=int64) :: i
call pdbread(inputfile,pdbcryst1,pdbatoms)
do i=1,size(atoms,1)
pdbatoms(i)%x=atoms(i)%x
pdbatoms(i)%y=atoms(i)%y
pdbatoms(i)%z=atoms(i)%z
end do
pdbatoms(:)%x=pdbatoms(:)%x*10.0_real32
pdbatoms(:)%y=pdbatoms(:)%y*10.0_real32
pdbatoms(:)%z=pdbatoms(:)%z*10.0_real32
call pdbwrite(outputfile,pdbcryst1,pdbatoms)
end subroutine saveAtomsOnPDB
subroutine pdbread(inputfile,pdbcryst1,pdbatoms)
character(len=*), intent(in) :: inputfile
type(pdb_cryst1_t), intent(out) :: pdbcryst1
type(pdb_atom_t), dimension(:), allocatable, intent(out) :: pdbatoms
logical :: flag
integer(kind=int64) :: numatoms
type(pdb_atom_t) :: tmp
open(unit=1,file=inputfile,form="FORMATTED")
allocate(pdbatoms(1))
flag=.True.
numatoms=0
do while (flag)
read(1,fmt="(A6)") tmp%ident
if (tmp%ident .eq. "CRYST1") then
backspace(1)
read(1,fmt=cryst1fmt) pdbcryst1%rname,pdbcryst1%a,pdbcryst1%b,&
pdbcryst1%c,pdbcryst1%alpha,pdbcryst1%beta,pdbcryst1%gamma,&
pdbcryst1%sgroup,pdbcryst1%zval
end if
if ((tmp%ident .eq. "ATOM") .or. (tmp%ident .eq. "HETATM")) then
backspace(1)
read(1,fmt=atomfmt) &
tmp%ident,tmp%anum,tmp%aname,tmp%altloc,tmp%resname,tmp%chainid,&
tmp%resnum,tmp%inscode,tmp%x,tmp%y,tmp%z,tmp%occup,tmp%tempf,&
tmp%segmentid,tmp%elsymb,tmp%charge
numatoms=numatoms+1
if (numatoms .eq. 1) then
pdbatoms(1)=tmp
else
call extendpdbatoms(pdbatoms,tmp)
end if
else
if ((tmp%ident .eq. "END") .or. (tmp%ident .eq. "ENDMDL")) then
flag=.False.
end if
end if
end do
close(1)
contains
subroutine extendpdbatoms(pdbatoms,newElement)
type(pdb_atom_t) :: newElement
type(pdb_atom_t), dimension(:), allocatable, intent(inout) :: pdbatoms
integer(kind=int64), dimension(1) :: array_s
type(pdb_atom_t), dimension(:), allocatable :: temp
array_s=shape(pdbatoms)
call move_alloc(pdbatoms,temp)
array_s(1)=array_s(1)+1
allocate(pdbatoms(array_s(1)))
pdbatoms(1:array_s(1)-1)=temp(:)
deallocate(temp)
pdbatoms(array_s(1))=newElement
end subroutine extendpdbatoms
end subroutine pdbread
subroutine pdbwrite(outputfile,pdbcryst1,pdbatoms)
character(len=*), intent(in) :: outputfile
type(pdb_cryst1_t), intent(in) :: pdbcryst1
type(pdb_atom_t), dimension(:), intent(in) :: pdbatoms
logical :: flag
integer(kind=int64) :: i
type(pdb_atom_t) :: tmp
open(unit=1,file=outputfile,form="FORMATTED")
write(1,fmt=cryst1fmt) pdbcryst1
do i=1,size(pdbatoms,1)
tmp=pdbatoms(i)
write(1,fmt=atomfmt) &
tmp%ident,tmp%anum,tmp%aname,tmp%altloc,tmp%resname,tmp%chainid,&
tmp%resnum,tmp%inscode,tmp%x,tmp%y,tmp%z,tmp%occup,tmp%tempf,&
tmp%segmentid,adjustr(tmp%elsymb),tmp%charge
end do
write(1,fmt="(A3)") "END"
close(1)
end subroutine pdbwrite
end module mod_pdb