Line data    Source code

       1              : ! ***********************************************************************
       2              : !
       3              : !   Copyright (C) 2017 Josiah Schwab & The MESA Team
       4              : !
       5              : !   This program is free software: you can redistribute it and/or modify
       6              : !   it under the terms of the GNU Lesser General Public License
       7              : !   as published by the Free Software Foundation,
       8              : !   either version 3 of the License, or (at your option) any later version.
       9              : !
      10              : !   This program is distributed in the hope that it will be useful,
      11              : !   but WITHOUT ANY WARRANTY; without even the implied warranty of
      12              : !   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
      13              : !   See the GNU Lesser General Public License for more details.
      14              : !
      15              : !   You should have received a copy of the GNU Lesser General Public License
      16              : !   along with this program. If not, see <https://www.gnu.org/licenses/>.
      17              : !
      18              : ! ***********************************************************************
      19              : 
      20              : module weak_support
      21              : 
      22              :   implicit none
      23              : 
      24              : contains
      25              : 
      26          141 :   subroutine parse_weak_rate_name(name, lhs, rhs, ierr)
      27              :     use chem_def
      28              :     use chem_lib
      29              :     character (len=*), intent(in) :: name
      30              :     character (len=iso_name_length), intent(out) :: lhs, rhs
      31              :     integer, intent(out) :: ierr
      32              : 
      33              :     integer :: len, i, j, cid
      34              : 
      35          141 :     ierr = -1
      36          141 :     len = len_trim(name)
      37          141 :     if (name(1:2) /= 'r_') return
      38          141 :     i = 3
      39              : 
      40              :     ! get lhs isotope
      41          141 :     call nxt
      42          141 :     cid = chem_get_iso_id(name(i:j))
      43          141 :     if (cid == nuclide_not_found) then
      44              :        return
      45              :     else
      46          141 :        lhs = name(i:j)
      47              :     end if
      48              : 
      49              :     ! check middle is wk or wk-minus
      50          141 :     i=j+2
      51          141 :     call nxt
      52          141 :     if (.not. ((name(i:j) == 'wk') .or. (name(i:j) == 'wk-minus'))) then
      53              :        return
      54              :     end if
      55              : 
      56              :     ! get rhs isotope
      57          141 :     i=j+2
      58          141 :     call nxt
      59          141 :     cid = chem_get_iso_id(name(i:j))
      60          141 :     if (cid == nuclide_not_found) then
      61              :        return
      62              :     else
      63          141 :        rhs = name(i:j)
      64              :     end if
      65              : 
      66          141 :     ierr = 0
      67              : 
      68              :   contains
      69              : 
      70              :     ! calling nxt sets j to last char of token
      71          423 :     subroutine nxt
      72          423 :       j = i
      73              :       do
      74         1646 :          if (j >= len) return
      75         1505 :          j = j+1
      76         1505 :          if (name(j:j) == '_') then
      77          282 :             j = j-1; return
      78              :          end if
      79              :       end do
      80          141 :     end subroutine nxt
      81              : 
      82              :   end subroutine parse_weak_rate_name
      83              : 
      84              : end module weak_support
      85              :