! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_pdb use mctc_env_accuracy, only : wp use mctc_io_convert, only : autoaa use mctc_io_structure, only : structure_type implicit none private public :: write_pdb contains subroutine write_pdb(mol, unit, number) type(structure_type), intent(in) :: mol integer, intent(in) :: unit integer, intent(in), optional :: number character(len=6) :: w1 character(len=4) :: sym character(len=2) :: a_charge character(len=1) :: last_chain logical :: last_het integer :: offset, iat, jat real(wp) :: xyz(3) character(len=*), parameter :: pdb_format = & & '(a6,i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,3f8.3,2f6.2,6x,a4,a2,a2)' if (present(number)) write(unit, '("MODEL ",4x,i4)') number if (allocated(mol%pdb)) then offset = 0 last_chain = mol%pdb(1)%chains last_het = mol%pdb(1)%het do iat = 1, mol%nat ! handle the terminator if (mol%pdb(iat)%het .neqv. last_het) then write(unit, '("TER ",i5,6x,a3,1x,a1,i4)') iat + offset, & & mol%pdb(iat-1)%residue, last_chain, mol%pdb(iat)%residue_number last_het = .not.last_het last_chain = mol%pdb(iat)%chains offset = offset+1 else if (mol%pdb(iat)%chains /= last_chain) then write(unit, '("TER ",i5,6x,a3,1x,a1,i4)') iat + offset, & & mol%pdb(iat-1)%residue, last_chain, mol%pdb(iat)%residue_number last_chain = mol%pdb(iat)%chains offset = offset+1 endif jat = iat + offset if (mol%pdb(iat)%het) then w1 = "HETATM" else w1 = "ATOM " endif sym = adjustr(mol%sym(mol%id(iat))(1:2)) xyz = mol%xyz(:,iat) * autoaa if (mol%pdb(iat)%charge < 0) then write(a_charge, '(i1,"-")') abs(mol%pdb(iat)%charge) else if (mol%pdb(iat)%charge > 0) then write(a_charge, '(i1,"+")') abs(mol%pdb(iat)%charge) else a_charge = ' ' endif write(unit, pdb_format) & & w1, jat, mol%pdb(iat)%name, mol%pdb(iat)%loc, & & mol%pdb(iat)%residue, mol%pdb(iat)%chains, mol%pdb(iat)%residue_number, & & mol%pdb(iat)%code, xyz, 1.0_wp, 0.0_wp, mol%pdb(iat)%segid, & & sym, a_charge enddo else do iat = 1, mol%nat w1 = "HETATM" sym = adjustr(mol%sym(mol%id(iat))(1:2)) xyz = mol%xyz(:,iat) * autoaa a_charge = ' ' write(unit, pdb_format) & & w1, iat, sym, " ", & & "UNK", "A", 1, " ", xyz, 1.0_wp, 0.0_wp, " ", & & sym, " " enddo end if if (present(number)) then write(unit, '("ENDMDL")') else write(unit, '("END")') endif end subroutine write_pdb end module mctc_io_write_pdb