! 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. !> Handle conversion between element symbols and atomic numbers module mctc_io_symbols use mctc_io_resize, only : resize implicit none private public :: symbol_length public :: symbol_to_number, number_to_symbol, number_to_lcsymbol public :: to_number, to_symbol, to_lcsymbol public :: get_identity, collect_identical !> Get chemical identity interface get_identity module procedure :: get_identity_number module procedure :: get_identity_symbol end interface get_identity !> Maximum allowed length of element symbols integer, parameter :: symbol_length = 4 !> Periodic system of elements character(len=2), parameter :: pse(118) = [ & & "H ","He", & & "Li","Be","B ","C ","N ","O ","F ","Ne", & & "Na","Mg","Al","Si","P ","S ","Cl","Ar", & & "K ","Ca", & & "Sc","Ti","V ","Cr","Mn","Fe","Co","Ni","Cu","Zn", & & "Ga","Ge","As","Se","Br","Kr", & & "Rb","Sr", & & "Y ","Zr","Nb","Mo","Tc","Ru","Rh","Pd","Ag","Cd", & & "In","Sn","Sb","Te","I ","Xe", & & "Cs","Ba", & & "La","Ce","Pr","Nd","Pm","Sm","Eu","Gd","Tb","Dy","Ho","Er","Tm","Yb", & & "Lu","Hf","Ta","W ","Re","Os","Ir","Pt","Au","Hg", & & "Tl","Pb","Bi","Po","At","Rn", & & "Fr","Ra", & & "Ac","Th","Pa","U ","Np","Pu","Am","Cm","Bk","Cf","Es","Fm","Md","No", & & "Lr","Rf","Db","Sg","Bh","Hs","Mt","Ds","Rg","Cn", & & "Nh","Fl","Mc","Lv","Ts","Og" ] !> Lower case version of the periodic system of elements character(len=2), parameter :: lcpse(118) = [ & & "h ","he", & & "li","be","b ","c ","n ","o ","f ","ne", & & "na","mg","al","si","p ","s ","cl","ar", & & "k ","ca", & & "sc","ti","v ","cr","mn","fe","co","ni","cu","zn", & & "ga","ge","as","se","br","kr", & & "rb","sr", & & "y ","zr","nb","mo","tc","ru","rh","pd","ag","cd", & & "in","sn","sb","te","i ","xe", & & "cs","ba","la", & & "ce","pr","nd","pm","sm","eu","gd","tb","dy","ho","er","tm","yb", & & "lu","hf","ta","w ","re","os","ir","pt","au","hg", & & "tl","pb","bi","po","at","rn", & & "fr","ra","ac", & & "th","pa","u ","np","pu","am","cm","bk","cf","es","fm","md","no", & & "lr","rf","db","sg","bh","hs","mt","ds","rg","cn", & & "nh","fl","mc","lv","ts","og" ] !> ASCII offset between lowercase and uppercase letters integer, parameter :: offset = iachar("a") - iachar("A") contains !> Convert element symbol to atomic number elemental subroutine symbol_to_number(number, symbol) !> Element symbol character(len=*), intent(in) :: symbol !> Atomic number integer, intent(out) :: number character(len=2) :: lcsymbol integer :: i, j, k, l number = 0 lcsymbol = " " k = 0 do j = 1, len_trim(symbol) if (k > 2) exit l = iachar(symbol(j:j)) if (k >= 1 .and. l == iachar(" ")) exit if (k >= 1 .and. l == 9) exit if (l >= iachar("A") .and. l <= iachar("Z")) l = l + offset if (l >= iachar("a") .and. l <= iachar("z")) then k = k+1 if (k > 2) exit lcsymbol(k:k) = achar(l) end if end do do i = 1, size(lcpse) if (lcsymbol == lcpse(i)) then number = i exit end if end do if (number == 0) then select case(lcsymbol) case("d ", "t ") number = 1 case default continue end select end if end subroutine symbol_to_number !> Convert atomic number to element symbol elemental subroutine number_to_symbol(symbol, number) !> Atomic number integer, intent(in) :: number !> Element symbol character(len=2), intent(out) :: symbol if (number <= 0 .or. number > size(pse)) then symbol = "--" else symbol = pse(number) end if end subroutine number_to_symbol !> Convert atomic number to element symbol elemental subroutine number_to_lcsymbol(symbol, number) !> Atomic number integer, intent(in) :: number !> Element symbol character(len=2), intent(out) :: symbol if (number <= 0 .or. number > size(lcpse)) then symbol = "--" else symbol = lcpse(number) end if end subroutine number_to_lcsymbol !> Convert element symbol to atomic number elemental function to_number(symbol) result(number) !> Element symbol character(len=*), intent(in) :: symbol !> Atomic number integer :: number call symbol_to_number(number, symbol) end function to_number !> Convert atomic number to element symbol elemental function to_symbol(number) result(symbol) !> Atomic number integer,intent(in) :: number !> Element symbol character(len=2) :: symbol call number_to_symbol(symbol, number) end function to_symbol !> Convert atomic number to element symbol elemental function to_lcsymbol(number) result(symbol) !> Atomic number integer,intent(in) :: number !> Element symbol character(len=2) :: symbol call number_to_lcsymbol(symbol, number) end function to_lcsymbol !> Get chemical identity from a list of atomic numbers pure subroutine get_identity_number(nid, identity, number) !> Number of unique species integer, intent(out) :: nid !> Ordinal numbers integer, intent(in) :: number(:) !> Chemical identity integer, intent(out) :: identity(:) integer, allocatable :: itmp(:) integer :: nat, iat, iid nat = size(identity) allocate(itmp(nat)) nid = 0 do iat = 1, nat iid = find_number(itmp(:nid), number(iat)) if (iid == 0) then call append_number(itmp, nid, number(iat)) iid = nid end if identity(iat) = iid end do end subroutine get_identity_number !> Get chemical identity from a list of element symbols pure subroutine get_identity_symbol(nid, identity, symbol) !> Number of unique species integer, intent(out) :: nid !> Element symbols character(len=*), intent(in) :: symbol(:) !> Chemical identity integer, intent(out) :: identity(:) character(len=len(symbol)), allocatable :: stmp(:) integer :: nat, iat, iid nat = size(identity) allocate(stmp(nat)) nid = 0 do iat = 1, nat iid = find_symbol(stmp(:nid), symbol(iat)) if (iid == 0) then call append_symbol(stmp, nid, symbol(iat)) iid = nid end if identity(iat) = iid end do end subroutine get_identity_symbol !> Establish a mapping between unique atom types and species pure subroutine collect_identical(identity, mapping) !> Chemical identity integer, intent(in) :: identity(:) !> Mapping from unique atoms integer, intent(out) :: mapping(:) integer :: iid, iat do iid = 1, size(mapping) do iat = 1, size(identity) if (identity(iat) == iid) then mapping(iid) = iat exit end if end do end do end subroutine collect_identical !> Find element symbol in an unordered list, all entries are required to be unique pure function find_symbol(list, symbol) result(position) !> List of element symbols character(len=*), intent(in) :: list(:) !> Element symbol character(len=*), intent(in) :: symbol !> Position of the symbol in list if found, otherwise zero integer :: position integer :: isym position = 0 do isym = 1, size(list) if (symbol == list(isym)) then position = isym exit end if end do end function find_symbol !> Find atomic number in an unordered list, all entries are required to be unique pure function find_number(list, number) result(position) !> List of atomic numbers integer, intent(in) :: list(:) !> Atomic number integer, intent(in) :: number !> Position of the number in list if found, otherwise zero integer :: position integer :: inum position = 0 do inum = 1, size(list) if (number == list(inum)) then position = inum exit end if end do end function find_number !> Append an element symbol to an unsorted list, to ensure no duplicates search !> for the element symbol first pure subroutine append_symbol(list, nlist, symbol) !> List of element symbols character(len=*), allocatable, intent(inout) :: list(:) !> Current occupied size of list integer, intent(inout) :: nlist !> Elements symbol character(len=*), intent(in) :: symbol if (nlist >= size(list)) then call resize(list) end if nlist = nlist + 1 list(nlist) = symbol end subroutine append_symbol !> Append an atomic number to an unsorted list, to ensure no duplicates search !> for the atomic number first pure subroutine append_number(list, nlist, number) !> List of atomic number integer, allocatable, intent(inout) :: list(:) !> Current occupied size of list integer, intent(inout) :: nlist !> Atomic number integer, intent(in) :: number if (nlist >= size(list)) then call resize(list) end if nlist = nlist + 1 list(nlist) = number end subroutine append_number end module mctc_io_symbols