Чтение химических символов в Фортране

Question

Я читаю список химических символов. Так как есть 118 элементов, select case построить будет иметь 119 случаев. Есть лучший способ сделать это? Некоторые элементы начинаются с той же буквы, например C, Ca, Cd, Coтак что, возможно, читая три A1 переменные вместо одной A3 переменная может несколько облегчить процесс.

program case_test
implicit none

character(len=3)   :: input
integer            :: i
real               :: mass

write(*,*) "Give me a symbol"

read(*,"(A3)") input

select case (input)
  case("H")
    mass = 1.008
  case("He")
    mass = 4.003
! 116 other checks
  case default
    write(*,*) "Unknown element ", input
    stop
end select

write(*,*) "atom mass = ", mass
end program case_test

Answer 1

В общем, мне нравится SELECTED CASE, но это кажется более простым...

MODULE Element_Definintions
IMPLICIT NONE

PUBLIC

INTEGER, PARAMETER, PUBLIC :: Max_Elements = 118

TYPE Elements_Type
  character(len=3)   :: Name
  integer            :: i
  real               :: mass
END TYPE Elements_Type

TYPE(Elements_Type), DIMENSION(Max_Elements), PUBLIC :: Elements

CONTAINS

SUBROUTINE Init_Elements
IMPLICIT NONE

Element(1).Name = "H"
Element(1).Num  = 1
Element(1).Mass = 1.008

Element(2).Name = "He"
Element(2).Num  = 2
Element(2).Mass = 4.008

!...
Element(118).Name = ""

RETURN
END SUBROUTINE Init_Elements

КОНЕЦ МОДУЛЯ Element_Definintions

Тогда программа...

program case_test
USE Element_Definintions
implicit none
character(len=3) :: input
LOGICAL          :: Found = .FALSE.

CALL Init_Elements()

write(*,*) "Give me a symbol"

read(*,"(A3)") input

DO I = 1, Max_Elements
  IF(Input(1:LEN_TRIM(Input)) == Element(I).Name(1:LEN_TRIM(Element(I).Name)) THEN
    FOUND= .TRUE.
    EXIT
  ELSE
    CYCLE
  ENDIF
ENDDO

IF(Found) THEN
  write(*,*) 'atom mass of "',Element(I).Name,'" = ', mass
ELSE
  write(*,*) 'Unknown element "', input,'"'
ENDIF

END program case_test

Answer 2

Существует небольшой конечный набор символов элементов (я думаю, что по последним подсчетам 118), который может поместиться в не слишком длинную текстовую строку. Фортран не лучший язык для обработки текста (я позволю Perl и SNOBOL бороться за это...), но современный Фортран немного улучшил ситуацию.

Есть некоторые предположения, основанные на следующем коде. Во-первых, мы ожидаем, что пользователь напечатает символ элемента в смешанном регистре. Вы можете исправить регистр, но для этого примера я решил просто выбросить ошибки, если первый символ в пользовательском вводе не был верхним регистром, а второй символ не был пробелом или нижним регистром. Это делается с помощью verify intrinsic, который был добавлен к языку в Фортране 95 (это буквально первый раз, когда я его использовал).

index() intrinsic даст вам начальное местоположение первого совпадения подстроки внутри большей строки, считая от 1, или вернет 0, если совпадение не найдено.

elblob Строка содержит каждый символ элемента, разделенный подчеркиванием. Элементы из одной буквы сохраняют завершающий пробел, чтобы соответствовать character(len=2) переменная. Две звездочки застряли в передней части elblob так что каждый элемент начинается с символа, кратного трем. Это немое волшебство, которое использует в своих интересах то, что мы знаем об атомных числах - они являются уникальными, последовательными, целыми числами, которые полностью заполняют диапазон от 1 до 118 (или каков бы ни был верхний элемент в наши дни).

Еще один хитрый момент, который, вероятно, решает проблемы, это использование adjustl() чтобы обеспечить первый символ в elseek это не пространство Это, вероятно, не может быть только из-за того, как Фортран read() работает, но я параноик, поэтому я положил его туда. Худшее, что он может сделать, это сжечь несколько циклов, ничего не делая. Вынь и посмотри, что получится.

Проверяя правильность пользовательского ввода, чтобы исключить случайные символы "_" и "*", мы можем быть уверены, что символы элементов будут правильно совпадать и что мы можем получить реальный атомный номер, разделив позицию соответствия, возвращаемую index() к трем. Углерод не будет случайно совпадать с кальцием, потому что строка поиска углерода - это "С", а не "С", что является следствием строк Фортрана с фиксированной длиной. Если elseek был определен как character(len=:), allocatable, у нас могут быть проблемы, но, используя немые старые строки с фиксированной длиной, заполненные пробелами, мы можем использовать их тупое старое поведение в наших интересах.

!> Return an element's atomic number based on its symbol.
program elements
    use iso_fortran_env, only: input_unit, output_unit
    implicit none

    character(len=*), parameter :: alpha_u = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
    character(len=*), parameter :: alpha_l = 'abcdefghijklmnopqrstuvwxyz'

    character(len=*), parameter :: elblob =                             &
    '**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'

    character(len=2) :: elseek
    character(len=1) :: c
    integer :: atomic_number

404 format("Sorry, I couldn't find ", '"', A, '"')
200 format("The element ", A, " has an atomic number of ", I0)
500 format('"', A, '" must be ', A, ' case letter')

    continue

    write(output_unit, '(A)') "Give me an element's symbol "            &
        // "(like H or Na)"

    read(input_unit, '(A2)') elseek

    ! Left-justify; eliminates any leading space
    ! (Q: is leading space even possible?)
    elseek = adjustl(elseek)

    c = elseek(1:1)
    if (verify(c, alpha_u) > 0) then
        write(output_unit, 500) c, 'an upper'
        stop(1)
    end if

    c = elseek(2:2)
    if (verify(c, alpha_l // ' ') > 0) then
        write(output_unit, 500) c, 'a lower'
        stop(2)
    end if

    atomic_number = index(elblob, elseek)
    if (atomic_number < 1) then
        write(output_unit, 404) elseek
    else
        atomic_number = atomic_number / 3
        write(output_unit, 200) elseek, atomic_number
    end if

end program elements

Во всяком случае, я проверял это в течение всех 30 секунд. Не используйте это для чего-либо критического для безопасности. Если это для домашней работы, по крайней мере, прочитайте и поймите код и перепишите его как свой собственный, чтобы Turnitin не пометил вас.

Это не самое надежное решение, но оно короткое и простое и соответствует требованиям, как написано. Он не требует хеш-таблицы, дерева поиска или какой-либо структуры данных, более сложной, чем строка. Это не займет много времени, чтобы заставить его работать под FORTRAN77, но в этом и заключается безумие...