commit fc80b71aade5a84df856f3829c81445b9539b1ca Author: Michael W. Heiss Date: Sun Apr 19 19:42:30 2026 +0200 Initial MOCCA standalone import diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0490b9c --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +build/ +cmake-build-*/ +*.swp +*.swo +__pycache__/ diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..aac4520 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,39 @@ +cmake_minimum_required(VERSION 3.20) + +project(MOCCA VERSION 0.1.0 LANGUAGES CXX) + +set(CMAKE_CXX_STANDARD 20) +set(CMAKE_CXX_STANDARD_REQUIRED ON) +set(CMAKE_CXX_EXTENSIONS OFF) + +add_library(mocca_lib + src/api.cpp + src/config_bridge.cpp + src/embedded_tables.cpp + src/json.cpp + src/kernel.cpp + src/line_codec.cpp + src/physics_engine.cpp +) + +target_include_directories(mocca_lib + PUBLIC + ${CMAKE_CURRENT_SOURCE_DIR}/include + PRIVATE + ${CMAKE_CURRENT_SOURCE_DIR}/src +) + +target_compile_options(mocca_lib + PRIVATE + -Wall + -Wextra + -Wpedantic +) + +add_executable(mocca + src/cli.cpp +) + +target_link_libraries(mocca PRIVATE mocca_lib) + +install(TARGETS mocca mocca_lib) diff --git a/README.md b/README.md new file mode 100644 index 0000000..7153a31 --- /dev/null +++ b/README.md @@ -0,0 +1,55 @@ +# MOCCA + +MOCCA is the standalone modern cascade application extracted from the larger refactor work. +The name stands for `MOdern Code for CAscade`. + +This repository contains only: +- the modern C++ cascade implementation +- a helper that translates legacy card decks into the modern JSON schema +- the original literature and published source material kept for provenance + +It intentionally does not depend on the old Python implementation or the earlier C++ refactor. + +## Build + +```bash +cmake -S . -B build +cmake --build build -j +``` + +This produces the `mocca` executable in `build/`. + +## Run + +```bash +./build/mocca examples/fe_stat_n15.json --output result.json +``` + +The executable reads a structured JSON input file and writes a structured JSON result artifact. +The bundled coefficient tables are compiled into the binary, so no external runtime data files are required. + +## Translate Legacy Decks + +```bash +python3 tools/card_to_json.py legacy_case.inp --output case.json +``` + +The translator is a standalone helper built on the Python standard library only. +It converts the historical card input into the JSON schema used by MOCCA. + +## Project Layout + +- `include/mocca`: public headers +- `src`: MOCCA implementation +- `tools/card_to_json.py`: legacy-card to JSON translator +- `examples`: example JSON inputs +- `docs`: high-level documentation +- `literature`: original papers and published source material + +## Literature + +The `literature/` folder keeps the original papers and source material that the implementation was checked against: + +- `Akylas_VR_1978.pdf` +- `1-s2.0-0010465578900991-main.pdf` +- `aama_v1_0.f` diff --git a/docs/architecture.md b/docs/architecture.md new file mode 100644 index 0000000..38d2e2d --- /dev/null +++ b/docs/architecture.md @@ -0,0 +1,19 @@ +# Architecture + +MOCCA keeps a small public surface: + +- `mocca::SimulationConfig` describes one cascade run as typed JSON-backed data. +- `mocca::run_simulation()` validates the config, runs the kernel, and returns a structured result artifact. +- `mocca` is the command-line wrapper around that library API. + +Internally, the code is split into a few focused layers: + +- `api.cpp`: JSON parsing and artifact serialization +- `config_bridge.cpp`: conversion from the public schema into the internal kernel state +- `physics_engine.cpp`: matrix elements, transition rates, and atomic-model preparation +- `kernel.cpp`: cascade propagation and state/line collection +- `line_codec.cpp`: packed line bookkeeping and decoding +- `embedded_tables.cpp`: compiled-in coefficient tables + +The modern public interface deliberately avoids the historical card vocabulary. +The old deck format survives only in the optional translator helper. diff --git a/docs/json_schema.md b/docs/json_schema.md new file mode 100644 index 0000000..d6d8f89 --- /dev/null +++ b/docs/json_schema.md @@ -0,0 +1,18 @@ +# JSON Schema Notes + +The MOCCA input schema is organized around physics concepts rather than card names: + +- `atom`: atomic number, shell charges, binding energies, and mass information +- `transitions`: explicit transition-energy inputs and optional Dirac-energy overrides +- `capture`: initial capture distribution +- `channels`: active monopole, dipole, quadrupole, and octupole channel settings +- `shell_model`: subshell populations, refill behavior, polarization handling, and shell cutoffs +- `reporting`: line filtering and output thresholds +- `model`: low-level physical constants that remain configurable +- `numerics`: numerical control knobs exposed by the standalone implementation + +The output artifact mirrors that structure and adds: + +- provenance fields such as `implementation_name`, `numerical_backend`, and `coefficient_table_id` +- the normalized `input` +- the computed `result`, including line catalog, state summaries, warnings, and Lyman sum diff --git a/examples/fe_stat_n15.json b/examples/fe_stat_n15.json new file mode 100644 index 0000000..dfd15ff --- /dev/null +++ b/examples/fe_stat_n15.json @@ -0,0 +1,63 @@ +{ + "schema_version": 1, + "metadata": { + "case_name": "fe_stat_n15" + }, + "atom": { + "atomic_number": 26.0, + "effective_shell_charges": [24.0, 22.0, 17.0], + "binding_energies_ev": [7.112e3, 8.46e2, 7.6e1], + "atomic_mass": 56.0, + "exact_mass_number": null + }, + "masses": { + "muon_electron_masses": 206.7686, + "electron_mass_ev": 511003.4, + "nucleon_mass_mev": 931.48 + }, + "transitions": { + "two_p_to_one_s_energy_ev": null, + "two_s_to_two_p_split_ev": null, + "dirac_energies": [] + }, + "capture": { + "mode": "statistical_l", + "n_max": 15, + "alpha": 0.22 + }, + "channels": { + "case_counts": [3, 4, 4, 4], + "monopole_shells": [1, 2, 3], + "dipole_shells": [0, 1, 2, 3], + "quadrupole_shells": [0, 1, 2, 3], + "octupole_shells": [0, 1, 2, 3], + "dipole_subshell_channels": [0, 0, 0, 0], + "quadrupole_subshell_channels": [0, 0, 0, 0], + "octupole_subshell_channels": [0, 0, 0, 0], + "dipole_penetration_codes": [0, 1, 1, 1], + "quadrupole_penetration_codes": [0, 1, 1, 1], + "octupole_penetration_codes": [0, 1, 1, 1], + "dipole_penetration_avg_n_cutoffs": [0, 0, 0, 0], + "quadrupole_penetration_avg_n_cutoffs": [0, 0, 0, 0], + "octupole_penetration_avg_n_cutoffs": [0, 0, 0, 0] + }, + "shell_model": { + "subshell_populations": [1, 1, 1, 1, 1, 1], + "refill_codes": [0, 0, 0], + "penetration_cutoffs": [1, 1, 1, 1], + "width_k_ev": 0.0, + "track_polarization": true + }, + "reporting": { + "line_energy_min_mev": 0.04, + "line_energy_max_mev": 20.0, + "line_intensity_threshold": 1.0e-6, + "energy_resolution_mev": 0.0003 + }, + "model": { + "factorial_divider": 15.0 + }, + "numerics": { + "matrix_element_precision_digits": 120 + } +} diff --git a/include/mocca/api.hpp b/include/mocca/api.hpp new file mode 100644 index 0000000..6ca2259 --- /dev/null +++ b/include/mocca/api.hpp @@ -0,0 +1,205 @@ +#pragma once + +#include +#include +#include +#include + +#include "mocca/json.hpp" + +namespace mocca { + +struct DiracEnergy { + int n{}; + int kappa{}; + double vacuum_polarization_kev{}; + double binding_kev{}; +}; + +struct NlWeight { + int n{}; + int l{}; + double weight{}; +}; + +enum class CaptureMode { + statistical_l, + quadratic_l, + explicit_l, + explicit_nl, + legacy_empty, +}; + +struct MetadataConfig { + std::string case_name; +}; + +struct AtomConfig { + double atomic_number{}; + std::vector effective_shell_charges; + std::vector binding_energies_ev; + double atomic_mass{}; + std::optional exact_mass_number; +}; + +struct MassConfig { + double muon_electron_masses{206.7682827}; + double electron_mass_ev{510998.95069}; + double nucleon_mass_mev{938.272013}; +}; + +struct TransitionConfig { + std::optional two_p_to_one_s_energy_ev; + std::optional two_s_to_two_p_split_ev; + std::vector dirac_energies; +}; + +/** + * Initial capture distribution configuration. + * + * The modern interface names the supported distribution families explicitly + * instead of routing them through the historical `NOP`/`IP` control cards. + */ +struct CaptureConfig { + CaptureMode mode{CaptureMode::statistical_l}; + int n_max{15}; + double alpha{0.0}; + std::vector quadratic_coefficients; + std::vector l_weights; + std::vector nl_weights; +}; + +struct ChannelConfig { + std::vector case_counts{3, 4, 4, 4}; + std::vector monopole_shells{1, 2, 3}; + std::vector dipole_shells{0, 1, 2, 3}; + std::vector quadrupole_shells{0, 1, 2, 3}; + std::vector octupole_shells{0, 1, 2, 3}; + std::vector dipole_subshell_channels{0, 0, 0, 0}; + std::vector quadrupole_subshell_channels{0, 0, 0, 0}; + std::vector octupole_subshell_channels{0, 0, 0, 0}; + std::vector dipole_penetration_codes{0, 1, 1, 1}; + std::vector quadrupole_penetration_codes{0, 1, 1, 1}; + std::vector octupole_penetration_codes{0, 1, 1, 1}; + std::vector dipole_penetration_avg_n_cutoffs{0, 0, 0, 0}; + std::vector quadrupole_penetration_avg_n_cutoffs{0, 0, 0, 0}; + std::vector octupole_penetration_avg_n_cutoffs{0, 0, 0, 0}; +}; + +struct ShellModelConfig { + std::vector subshell_populations{1.0, 1.0, 1.0, 1.0, 1.0, 1.0}; + std::vector refill_codes{0, 0, 0}; + std::vector penetration_cutoffs{1.0, 1.0, 1.0, 1.0}; + double width_k_ev{0.0}; + bool track_polarization{true}; +}; + +struct ReportingConfig { + double line_energy_min_mev{0.040}; + double line_energy_max_mev{20.0}; + double line_intensity_threshold{1.0e-06}; + double energy_resolution_mev{0.000300}; +}; + +struct ModelConfig { + double factorial_divider{15.0}; +}; + +struct NumericsConfig { + int matrix_element_precision_digits{120}; +}; + +/** + * Structured input schema for the new public-facing cascade interface. + * + * The schema is deliberately aligned with the validated cascade model while + * removing the legacy punch-card interface. It exposes the physics controls + * and precision settings needed by the modern kernel without leaking the + * historical deck/card vocabulary into the public API. + */ +struct SimulationConfig { + int schema_version{1}; + MetadataConfig metadata; + AtomConfig atom; + MassConfig masses; + TransitionConfig transitions; + CaptureConfig capture; + ChannelConfig channels; + ShellModelConfig shell_model; + ReportingConfig reporting; + ModelConfig model; + NumericsConfig numerics; +}; + +struct TransitionLine { + int n1{}; + int l1{}; + int j1_twice{}; + int n2{}; + int l2{}; + int j2_twice{}; + std::string multipole; + double energy_kev{}; + double intensity{}; +}; + +struct StateSummary { + int n{}; + int l{}; + double population{}; + std::optional polar_up; + std::optional polar_down; + std::optional width_ev; + std::optional rad_to_auger; + std::optional spin_orbit_ev; + double k_electrons{}; + double l_electrons{}; + double m_electrons{}; +}; + +struct SimulationResult { + double lyman_sum{}; + int num_lines{}; + std::vector lines; + std::vector states; + std::vector warnings; +}; + +/** + * JSON artifact emitted by the `mocca` CLI. + * + * It includes enough provenance to make regression outputs self-contained: + * the parsed input, the selected matrix-element precision, the coefficient-table + * source, and the resulting physics observables. + */ +struct SimulationArtifact { + int schema_version{1}; + std::string implementation_name{"MOCCA"}; + std::string numerical_backend{"modern_kernel"}; + std::string coefficient_table_id{"aama_v1_0_block_data_v1"}; + int matrix_element_precision_digits{120}; + SimulationConfig input; + SimulationResult result; +}; + +/** + * Parse a modern JSON configuration document into a typed schema object. + */ +SimulationConfig parse_config_text(std::string_view text); + +/** + * Load and parse a modern JSON configuration file. + */ +SimulationConfig load_config(const std::filesystem::path& path); + +JsonValue to_json(const SimulationConfig& config); +JsonValue to_json(const SimulationResult& result); +JsonValue to_json(const SimulationArtifact& artifact); + +/** + * Run the modern cascade kernel on a structured config and return a fully + * serialized-ready artifact. + */ +SimulationArtifact run_simulation(const SimulationConfig& config); + +} // namespace mocca diff --git a/include/mocca/json.hpp b/include/mocca/json.hpp new file mode 100644 index 0000000..86625b5 --- /dev/null +++ b/include/mocca/json.hpp @@ -0,0 +1,59 @@ +#pragma once + +#include +#include +#include +#include +#include +#include + +namespace mocca { + +/** + * Minimal JSON value type used by the modern configuration and result layer. + * + * The project only needs a small subset of JSON infrastructure, so this keeps + * parsing and serialization self-contained instead of adding another external + * dependency. + */ +class JsonValue { +public: + using Array = std::vector; + using Object = std::map; + + JsonValue() = default; + JsonValue(std::nullptr_t); + JsonValue(bool value); + JsonValue(double value); + JsonValue(int value); + JsonValue(std::string value); + JsonValue(const char* value); + JsonValue(Array value); + JsonValue(Object value); + + [[nodiscard]] bool is_null() const; + [[nodiscard]] bool is_bool() const; + [[nodiscard]] bool is_number() const; + [[nodiscard]] bool is_string() const; + [[nodiscard]] bool is_array() const; + [[nodiscard]] bool is_object() const; + + [[nodiscard]] bool as_bool() const; + [[nodiscard]] double as_number() const; + [[nodiscard]] const std::string& as_string() const; + [[nodiscard]] const Array& as_array() const; + [[nodiscard]] const Object& as_object() const; + [[nodiscard]] Array& as_array(); + [[nodiscard]] Object& as_object(); + + [[nodiscard]] bool contains(const std::string& key) const; + [[nodiscard]] const JsonValue& at(const std::string& key) const; + +private: + std::variant data_{nullptr}; +}; + +JsonValue parse_json(std::string_view text); +std::string to_json_string(const JsonValue& value, int indent = 2); + +} // namespace mocca diff --git a/include/mocca/kernel.hpp b/include/mocca/kernel.hpp new file mode 100644 index 0000000..9ee7716 --- /dev/null +++ b/include/mocca/kernel.hpp @@ -0,0 +1,36 @@ +#pragma once + +#include + +#include "mocca/api.hpp" + +namespace mocca { + +/** + * Modern execution façade for the cascade physics kernel. + * + * The public surface stays intentionally small: callers provide a normalized + * `SimulationConfig`, and the implementation owns the setup, propagation, and + * line-collection workflow behind a value-oriented interface. + */ +class ModernCascadeKernel { +public: + explicit ModernCascadeKernel(const SimulationConfig& config); + ~ModernCascadeKernel(); + + ModernCascadeKernel(ModernCascadeKernel&&) noexcept; + ModernCascadeKernel& operator=(ModernCascadeKernel&&) noexcept; + + ModernCascadeKernel(const ModernCascadeKernel&) = delete; + ModernCascadeKernel& operator=(const ModernCascadeKernel&) = delete; + + [[nodiscard]] SimulationResult run() const; + +private: + class Impl; + std::unique_ptr impl_; +}; + +[[nodiscard]] SimulationResult run_modern_kernel(const SimulationConfig& config); + +} // namespace mocca diff --git a/literature/1-s2.0-0010465578900991-main.pdf b/literature/1-s2.0-0010465578900991-main.pdf new file mode 100644 index 0000000..2f80b14 Binary files /dev/null and b/literature/1-s2.0-0010465578900991-main.pdf differ diff --git a/literature/Akylas_VR_1978.pdf b/literature/Akylas_VR_1978.pdf new file mode 100644 index 0000000..07a7dd5 Binary files /dev/null and b/literature/Akylas_VR_1978.pdf differ diff --git a/literature/aama_v1_0.f b/literature/aama_v1_0.f new file mode 100644 index 0000000..c74d4fd --- /dev/null +++ b/literature/aama_v1_0.f @@ -0,0 +1,2764 @@ +AAMAMUONIC ATOM CASCADE. MUONIC ATOM CASCADE PROGRAM. V.R. AKYLAS, AAMA0000 +1 P. VOGEL. AAMA0000 +REF. IN COMP. PHYS. COMMUN. 15 (1978) 291 AAMA0000 + AAMA0001 +*NOSTAGE AAMA0002 +(CASCADE PROGRAM AAMA0003 +COMMENT. ************************************************************ AAMA0004 +COMMENT. * THE CONTROL CARDS IN THIS PROGRAM HAVE BEEN ADAPTED TO * AAMA0005 +COMMENT. * THE FEATURES AVAILABLE IN THE CDC7600 MACHINE OF * AAMA0006 +COMMENT. * BERKELEY. THEY MIGHT NOT USE STANDARD CDC FEATURES. * AAMA0007 +COMMENT. * THIS DECK CONTAINS *2760* NUMBER OF CARDS SERIALIZED * AAMA0008 +COMMENT. * SEQUENTIALLY IN COLUMNS 77 TO 80. THERE ARE THREE * AAMA0009 +COMMENT. * MAJOR PORTIONS IN THE DECK/ 1) CONTROL CARDS, 2) PRO- * AAMA0010 +COMMENT. * GRAM INCLUDING SUBROUTINES, AND 3) SAMPLE DATA FOR THE * AAMA0011 +COMMENT. * TEST CASE DEMONSTRATED. THE CONTROL CARDS OF THIS * AAMA0012 +COMMENT. * RECORD COMPILE, LOAD, AND EXECUTE THE PROGRAM, USING THE* AAMA0013 +COMMENT. * *BKY24B V2* OPERATING SYSTEM (CHECK DONE ON 18-FEB-78). * AAMA0014 +COMMENT. ************************************************************ AAMA0015 +FBSIZE(OUTPUT=250) OPTIMIZE BUFFER SIZE FOR OUTPUT (ADJUSTED FOR HERE) AAMA0016 +FBSIZE(LGO=50) OPTIMIZE BUFFER SIZE FOR LOADING (ADJUSTED FOR HERE)AAMA0017 +SFL,120000,130000. REQUEST MORE MEMORY (INSTEAD OF DISK SPACE) AAMA0018 +FTN4,OPT=2,P,PL=30000,R=3. FTN4 COMPILER, HIGH OPTIMIZATION, FULL MAP AAMA0019 +SYMLIST. GET A SYMBOL LIST FOR CROSS-REFERENCE (DEBUG AID) AAMA0020 +LINK(B,RF) LINK THE COMPILED FILE, RETURN FILE FOR EXECUTION AAMA0021 +MAKE75(LGOB,L=OUTPUT) ADJUST CORE TO THE EXACT REQUIREMENTS AAMA0022 +LGOB. LOAD AND EXECUTE... TAKE DATA FROM THE NEXT RECORD AAMA0023 +" 7/8/9 CARD -- END-OF-RECORD --------------------------------- AAMA0024 + PROGRAM MUON00(INPUT,OUTPUT,PUNCH,TAPE5=INPUT,TAPE6=OUTPUT,TAPE7AAMA0025 + 1 =PUNCH) AAMA0026 +C *** MODIFY OR DELETE THIS STATEMENT, ACCORDING TO THE REQUIREMENTS AAMA0027 +C *** OF THE PARTICULAR INSTALLATION. NOTE THAT THE PUNCH IS OPTIONAL.AAMA0028 +C *** STANDARD ANSI FORTRAN IV IS USED WITH FEW UNAVOIDABLE EXCEPTIONSAAMA0029 +C****************************** IMPORTANT NOTE *************************AAMA0030 +C THIS PROGRAM HAS BEEN CONDENSED BY PLACING SEVERAL SHORT AAMA0031 +C STATEMENTS IN THE SAME LINE, SEPARATED BY A DOLLAR SIGN (CDC AAMA0032 +C CONVENTION). THE FIRST SMALL PROGRAM BELOW IF RUN (WITH THE C AAMA0033 +C REMOVED FROM COL.1), WILL CHANGE THE DOLLAR SIGN TO ANY OTHER AAMA0034 +C CHARACTER (SAMPLE IS ;). THE SECOND PROGRAM WILL EXPAND THE AAMA0035 +C DECK, SO THAT ONLY ONE STATEMENT APPEARS ON EACH CARD. IN BOTH AAMA0036 +C CASES THE REST OF THE PROGRAM SHOULD BE PLACED AS INPUT. AAMA0037 +C A STOP CARD IS REQUIRED FOR NORMAL TERMINATION (STOP IN COLS1-4)AAMA0038 +C***********************************************************************AAMA0039 +C DIMENSION I(72),IS(4) AAMA0040 +C DATA ID,IS,IA/1H$,1HS,1HT,1HO,1HP,1H;/ AAMA0041 +C 100 READ(5,200)I AAMA0042 +C 200 FORMAT(72A1) AAMA0043 +C 0 IF(I(1).EQ.IS(1).AND.I(2).EQ.IS(2).AND. AAMA0044 +C 1 I(3).EQ.IS(3).AND.I(4).EQ.IS(4)) STOP AAMA0045 +C DO 300 J=1,72 AAMA0046 +C IF(I(J).EQ.ID) I(J) = IA AAMA0047 +C 300 CONTINUE AAMA0048 +C GO TO 100 AAMA0049 +C END AAMA0050 +C-----------------------------------------------------------------------AAMA0051 +C DIMENSION I(75),IS(4) AAMA0052 +C DATA ID,IB,IS,I/1H$,1H ,1HS,1HT,1HO,1HP,75*1H / AAMA0053 +C 100 READ(5,200)(I(K),K=1,72) AAMA0054 +C 200 FORMAT(72A1) AAMA0055 +C 0 IF(I(1).EQ.IS(1).AND.I(2).EQ.IS(2).AND. AAMA0056 +C 1 I(3).EQ.IS(3).AND.I(4).EQ.IS(4)) STOP AAMA0057 +C II = 0 AAMA0058 +C IL = 1 AAMA0059 +C DO 600 K=1,72 AAMA0060 +C IR = K AAMA0061 +C IF(I(K+1).EQ.IB.AND.I(K+2).EQ.ID.AND.I(K+3).EQ.IB) GO TO 300 AAMA0062 +C IF(K.EQ.72) GO TO 300 AAMA0063 +C GO TO 600 AAMA0064 +C 300 II = II + 1 AAMA0065 +C IF(II.EQ.1) WRITE(7,400)(I(M),M=IL,IR) AAMA0066 +C 400 FORMAT(72A1) AAMA0067 +C 0 IF(II.GT.1) WRITE(7,500)(I(M),M=IL,IR) AAMA0068 +C 500 FORMAT(8X,72A1) AAMA0069 +C 0 IF(K.EQ.72) GO TO 100 AAMA0070 +C IL = IR + 4 AAMA0071 +C 600 CONTINUE AAMA0072 +C END AAMA0073 +C-----------------------------------------------------------------------AAMA0074 +C *** PROGRAM <> AAMA0075 +C <<< INITIALLY WRITTEN BY V.R.AKYLAS, CALTECH -- FEBR. 1978 >>> AAMA0076 +C <<< LAST VERSION MODIFIED BY ............................. >>> AAMA0077 +C.......................................................................AAMA0078 + DIMENSION I9(4),K9(4,4),M9(4,7),J9(9,10),J4(9,5,4),JX(4),ID9(5),AAMA0079 + 1 IXX(3,20),PLX(20) AAMA0080 + DOUBLE PRECISION F,DZA,DZA2,DREDM AAMA0081 + COMMON/LOC001/IJK,ENERG,ECONS,ECONST,D2P1SM,D2P1S AAMA0082 + COMMON/LOC002/BEM(3),ZSA(3),BE(3) $ COMMON/LOC003/K0,K1,K2,K3 AAMA0083 + COMMON/LOC004/NN0(3),NN1(7),NN2(7),NN3(7) AAMA0084 + COMMON/LOC005/R0(3),R1(7),R2(7),R3(7) AAMA0085 + COMMON/LOC006/IP1(7),IP2(7),IP3(7),IQ1(7),IQ2(7),IQ3(7) AAMA0086 + COMMON/LOC007/IC $ COMMON/LOC008/IREAD,IW,IPUNCH,IPRINT AAMA0087 + COMMON/LOC009/F(60),FD AAMA0088 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA0089 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA0090 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC013/COEMON(30),EXPMON(30) AAMA0091 + COMMON/LOC014/COEDIP(42),EXPDIP(42) AAMA0092 + COMMON/LOC015/COEQUA(45),EXPQUA(45) AAMA0093 + COMMON/LOC016/COEOCT(45),EXPOCT(45) $ COMMON/LOC017/IFM(6) AAMA0094 + COMMON/LOC018/IFD(9) $ COMMON/LOC019/IFQ(10) AAMA0095 + COMMON/LOC020/IFO(10) $ COMMON/LOC021/ANGD,ANGQ,ANGO AAMA0096 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA0097 + COMMON/LOC023/COEDP(9) $ COMMON/LOC024/COEQ(11) AAMA0098 + COMMON/LOC025/COEO(11) $ COMMON/LOC026/COED(4) AAMA0099 + COMMON/LOC027/LL(20) AAMA0100 + COMMON/LOC028/M1(7),M2(7),M3(7),YC(4),IDB AAMA0101 + COMMON/LOC029/IRR,RR(18),RAU,RAD,RA(4),RD(4),RSA(4) AAMA0102 + COMMON/LOC030/POP(6),JTM(6),JTD(6),JTQ(6),JTO(6) AAMA0103 + COMMON/LOC031/JM(10),JD(14),JQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA0104 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA0105 + COMMON/LOC033/M,E(1000),AI(1000),IA(1000),ENERGY(20,40) AAMA0106 + COMMON/LOC034/DZA,DZA2,DREDM $ COMMON/LOC035/ICC,CD(5),EA,EB,IDRAAMA0107 + COMMON/LOC036/ZMK,ZML,ZMM,ZMKM,ZMLM,ZMMM,IVERS AAMA0108 + COMMON/LOC037/PL(20),NPOL(20),IPOL,CL1,CL2,IDE,PLN(210),IP8 AAMA0109 + COMMON/LOC038/A,CFM,TFM,STEP,RMATCH,WIDTHK,IPC(3) AAMA0110 + COMMON/LOC039/NOPT,NMAX,ALEXP $ COMMON/LOC040/AMASSA,AMASSN,HBARAAMA0111 + COMMON/LOC041/MPU,ICPU(200),IPN AAMA0112 +C *** NOTE -- NON-STANDARD WAY OF OVERPRINTING -- CHANGE AS NEEDED AAMA0113 +C *** STANDARD FORTRAN REQUIRES DATA FOR I9 /1H ,1H+,1H+,1H+/ AAMA0114 + DATA K9/2HRD,2H1S,2H2T,2H3T,2HRD,2H1S,2H2S,2H3S,2HRD,2H**,2H2P, AAMA0115 + 1 2H3P,2HRD,2H**,2H**,2H3D/ $ DATA I9,L9/1H+,1H+,1H+,1H ,2H--/ AAMA0116 + DATA J9/124,254,455,387,387,387,455,254,124,024,056,120,024,024,AAMA0117 + 1 024,024,126,126,124,254,455,391,030,056,112,255,511,511,510,028,AAMA0118 + 2 112,056,014,391,254,124,014,030,054,102,255,511,006,015,015,511,AAMA0119 + 3 511,384,508,254,007,391,254,124,124,254,385,508,510,387,455,254,AAMA0120 + 4 124,511,511,007,014,028,056,112,224,448,124,254,387,455,254,455,AAMA0121 + 5 387,254,124,124,254,455,387,255,127,259,254,124/ AAMA0122 + DATA JX,JB/1HX,1HI,1HH,1HO,1H / $ WRITE(IW,100) AAMA0123 + 100 FORMAT(1H1////1H ,60(1H*)/24X,13HDOCUMENTATION/ AAMA0124 + 1 60H THIS PROGRAM COMPUTES THE CASCADE OF NEGATIVE PARTICLES/AAMA0125 + 2 60H IN ATOMS. FOR MORE INFORMATION CONSULT THE ASSOCIATED /AAMA0126 + 3 60H WRITEUP, WHICH EXPLAINS THE INPUT OPTIONS AND OUTPUT /AAMA0127 + 4 60H RESULTS. THE PHYSICS INVOLVED IS TREATED IN THE THESIS OF /AAMA0128 + 5 21H THE ORIGINAL AUTHOR./1H ,60(1H*)///) AAMA0129 + 0 WRITE(IW,200) AAMA0130 + 200 FORMAT(1H ,60(1H*)/26X,9HBEMERKUNG/ AAMA0131 + 1 60H DIESES PROGRAMM BERECHNET DIE CASCADE NEGATIVER TEILCHEN/AAMA0132 + 2 60H IN ATOMEN. FUER EINZELHEITEN SIEHE DAZUGEHOERIGE /AAMA0133 + 3 60H EINFUEHRUNG, WO DIE INPUT UND OUTPUT PARAMETER AUFGEFUEHRT /AAMA0134 + 4 60H SIND. DIE THEORIE WIRD IN DER DOKTOR DISSERTATION DES /AAMA0135 + 5 18H AUTORS BEHANDELT./1H ,60(1H*)///) AAMA0136 + 0 WRITE(IW,300) AAMA0137 + 300 FORMAT(1H ,60(1H*)/24X,13HDOCUMENTATION/ AAMA0138 + 1 60H CE PROGRAMME CALCULE LA CASCADE ATOMIQUE DES PARTICULES /AAMA0139 + 2 60H NEGATIVES. POUR INFORMATION SUPPLEMENTAIRE CONSULTER LE /AAMA0140 + 3 60H MANUEL, QUI EXPLIQUE LES PARAMETRES D/ ENTREE ET RESULTATS./AAMA0141 + 4 60H LA THEORIE DU PROGRAMME EST PRESENTEE DANS LA THESE DU /AAMA0142 + 5 16H PREMIER AUTEUR./1H ,60(1H*)///) AAMA0143 + 0 WRITE(IW,400) AAMA0144 + 400 FORMAT(1H ,60(1H-)/41H V. R. AKYLAS, PH.D. THESIS, CALIFORNIA I,AAMA0145 + 1 50HNSTITUTE OF TECHNOLOGY, 1978 (UNPUBLISHED) /1H1) AAMA0146 + 0 DO 1100 I=1,20 $ PL(I) = 0.000 AAMA0147 + 1100 CONTINUE $ M = 1 $ DO 1150 I=1,20 $ DO 1150 J=1,40 AAMA0148 + ENERGY(I,J) = 0.000 AAMA0149 + 1150 CONTINUE AAMA0150 + 1175 M = 1 $ CALL RREAD $ CALL FFIX $ DO 1500 N=1,NMAX $ K = 2*N-1 AAMA0151 + DO 1500 L=1,K $ L1 = (L-1)/2 + 1 $ NJ = N $ PT = POINT(NJ,L1) AAMA0152 + IF(ENERGY(N,L).LE.0.000.AND.MOD(IPRINT,2).EQ.0) AAMA0153 + 1 WRITE(IW,1200)N,L,PT AAMA0154 + 1200 FORMAT(27H NO INPUT DATA FOR STATE N=,I2,7H, (LJ)=,I2, AAMA0155 + 1 29H, POINT-LIKE DIRAC ENERGY = ,F10.6,5H(MEV)) AAMA0156 + 0 IF(ENERGY(N,L).LE.0.000) ENERGY(N,L) = PT-ENERGY(N,L) AAMA0157 + 1500 CONTINUE $ IF(NMAX.EQ.20) GO TO 1700 $ MX1 = NMAX+1 AAMA0158 + DO 1600 I=MX1,20 $ PL(I) = 0.000 AAMA0159 + 1600 CONTINUE AAMA0160 + 1700 IF(NOPT.NE.0) GO TO 1900 $ DO 1800 I=1,NMAX AAMA0161 + PL(I) = FLOAT(2*I-1)*EXP( ALEXP*FLOAT(I-1)) AAMA0162 + 1800 CONTINUE AAMA0163 + 1900 IF(NOPT.NE.2) GO TO 1950 $ DO 1925 I=1,NMAX AAMA0164 + PL(I) = 1.000 + CL1*FLOAT(I-1) + CL2*FLOAT((I-1)**2) AAMA0165 + 1925 CONTINUE AAMA0166 + 1950 SS = 0.000 $ DO 2000 I=1,NMAX $ SS = SS + PL(I) AAMA0167 + 2000 CONTINUE $ IF(SS.LE.0.000) WRITE(IW,2100)(PL(I),I=1,NMAX) AAMA0168 + 2100 FORMAT(47H *** ERROR *** INITIAL L DISTRIBUTION WRONG ***/ AAMA0169 + 1 (1X,5F10.6)) AAMA0170 + 0 IF(SS.LE.0.000) SS=1.000 $ DO 2200 I=1,NMAX $ PL(I) = PL(I)/SS AAMA0171 + 2200 CONTINUE $ IF(MPU.GT.1.AND.IPN.EQ.0) WRITE(IPUNCH,2300)MPU,IDE AAMA0172 + 2300 FORMAT(14(1H*),19H NEW FIT -- AT MOST,I4,15H LINES PUNCHED , AAMA0173 + 1 20(1H*),I5) AAMA0174 + DO 2400 I=1,4 $ DO 2400 J=1,7 $ M9(I,J) = L9 AAMA0175 + 2400 CONTINUE $ IF(K0.EQ.0) GO TO 2500 $ DO 2450 I=1,K0 $ AAMA0176 + J = NN0(I) $ M9(1,I) = K9(J+1,1) AAMA0177 + 2450 CONTINUE AAMA0178 + 2500 IF(K1.EQ.0) GO TO 2600 $ DO 2550 I=1,K1 AAMA0179 + J = NN1(I) $ K = M1(I) $ M9(2,I) = K9(J+1,K+1) AAMA0180 + 2550 CONTINUE AAMA0181 + 2600 IF(K2.EQ.0) GO TO 2700 $ DO 2650 I=1,K2 AAMA0182 + J = NN2(I) $ K = M2(I) $ M9(3,I) = K9(J+1,K+1) AAMA0183 + 2650 CONTINUE AAMA0184 + 2700 IF(K3.EQ.0) GO TO 2800 $ DO 2750 I=1,K3 AAMA0185 + J = NN3(I) $ K = M3(I) $ M9(4,I) = K9(J+1,K+1) AAMA0186 + 2750 CONTINUE AAMA0187 + 2800 IZ9 = IFIX(Z+0.500) $ IZ1 = MOD(IZ9,10) + 1 $ IZ2 = IZ9/10 + 1 AAMA0188 + ID1 = MOD(IDE,10)+1 $ ID2 = MOD(IDE/10,10)+1 $ ID5 = IDE/10000+1AAMA0189 + ID3 = MOD(IDE/100,10) + 1 $ ID4 = MOD(IDE/1000,10) + 1 AAMA0190 + IF(IP8.EQ.0) GO TO 3100 $ SS = 0.000 $ NU = NMAX*(NMAX+1)/2 AAMA0191 + DO 2900 I=1,NU $ SS = SS + PLN(I) AAMA0192 + 2900 CONTINUE $ IF(SS.LE.0.000) WRITE(IW,2100) AAMA0193 + IF(SS.LE.0.000) SS=1.000 $ DO 3000 I=1,NU $ PLN(I) = PLN(I)/SS AAMA0194 + 3000 CONTINUE AAMA0195 + 3100 ID9(1) = IZ2 $ ID9(2) = IZ1 AAMA0196 + WRITE(IW,4000)I9(1) $ DO 4099 I=2,4 $ WRITE(IW,4010)I9(I) AAMA0197 + 4099 CONTINUE $ DO 4199 I=1,4 $ WRITE(IW,4100)I9(I) AAMA0198 + 4199 CONTINUE $ DO 4249 I=1,9 $ DO 4249 J=1,2 $ DO 4249 K=1,4 AAMA0199 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0200 + IF(MOD(J9(1,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0201 + 4249 CONTINUE $ WRITE(IW,4200)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0202 + DO 4299 K=2,4 $ WRITE(IW,4210)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0203 + 4299 CONTINUE $ DO 4349 I=1,9 $ DO 4349 J=1,2 $ DO 4349 K=1,4 AAMA0204 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0205 + IF(MOD(J9(2,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0206 + 4349 CONTINUE $ WRITE(IW,4300)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0207 + DO 4399 K=2,4 $ WRITE(IW,4310)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0208 + 4399 CONTINUE $ DO 4449 I=1,9 $ DO 4449 J=1,2 $ DO 4449 K=1,4 AAMA0209 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0210 + IF(MOD(J9(3,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0211 + 4449 CONTINUE $ WRITE(IW,4400)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0212 + DO 4499 K=2,4 $ WRITE(IW,4410)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0213 + 4499 CONTINUE $ DO 4549 I=1,9 $ DO 4549 J=1,2 $ DO 4549 K=1,4 AAMA0214 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0215 + IF(MOD(J9(4,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0216 + 4549 CONTINUE AAMA0217 + WRITE(IW,4500)I9(1),((J4(I,J,1),I=1,9),J=1,2),NMAX,NOPT AAMA0218 + DO 4599 K=2,4 AAMA0219 + WRITE(IW,4510)I9(K),((J4(I,J,K),I=1,9),J=1,2),NMAX,NOPT AAMA0220 + 4599 CONTINUE $ DO 4649 I=1,9 $ DO 4649 J=1,2 $ DO 4649 K=1,4 AAMA0221 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0222 + IF(MOD(J9(5,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0223 + 4649 CONTINUE AAMA0224 + WRITE(IW,4600)I9(1),((J4(I,J,1),I=1,9),J=1,2),ALEXP,CL1,CL2 AAMA0225 + DO 4699 K=2,4 AAMA0226 + WRITE(IW,4610)I9(K),((J4(I,J,K),I=1,9),J=1,2),ALEXP,CL1,CL2 AAMA0227 + 4699 CONTINUE $ DO 4749 I=1,9 $ DO 4749 J=1,2 $ DO 4749 K=1,4 AAMA0228 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0229 + IF(MOD(J9(6,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0230 + 4749 CONTINUE $ IF(IP8.EQ.0) WRITE(IW,4700)I9(1),((J4(I,J,1),I=1,9),AAMA0231 + 1 J=1,2),(PL(I),I=1,10) AAMA0232 + IF(IP8.NE.0) WRITE(IW,4720)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0233 + DO 4799 K=2,4 $ IF(IP8.EQ.0) WRITE(IW,4710)I9(K),((J4(I,J,K), AAMA0234 + 1 I=1,9),J=1,2),(PL(I),I=1,10) AAMA0235 + IF(IP8.NE.0) WRITE(IW,4730)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0236 + 4799 CONTINUE $ DO 4849 I=1,9 $ DO 4849 J=1,2 $ DO 4849 K=1,4 AAMA0237 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0238 + IF(MOD(J9(7,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0239 + 4849 CONTINUE $ IF(IP8.EQ.0) WRITE(IW,4800)I9(1),((J4(I,J,1),I=1,9),AAMA0240 + 1 J=1,2),(PL(I),I=11,20) AAMA0241 + IF(IP8.NE.0) WRITE(IW,4820)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0242 + DO 4899 K=2,4 $ IF(IP8.EQ.0) WRITE(IW,4810)I9(K),((J4(I,J,K), AAMA0243 + 1 I=1,9),J=1,2),(PL(I),I=11,20) AAMA0244 + IF(IP8.NE.0) WRITE(IW,4830)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0245 + 4899 CONTINUE $ DO 4949 I=1,9 $ DO 4949 J=1,2 $ DO 4949 K=1,4 AAMA0246 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0247 + IF(MOD(J9(8,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0248 + 4949 CONTINUE $ WRITE(IW,4900)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0249 + DO 4999 K=2,4 $ WRITE(IW,4910)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0250 + 4999 CONTINUE $ DO 5049 I=1,9 $ DO 5049 J=1,2 $ DO 5049 K=1,4 AAMA0251 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0252 + IF(MOD(J9(9,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0253 + 5049 CONTINUE $ WRITE(IW,5000)I9(1),((J4(I,J,1),I=1,9),J=1,2) AAMA0254 + DO 5099 K=2,4 $ WRITE(IW,5010)I9(K),((J4(I,J,K),I=1,9),J=1,2) AAMA0255 + 5099 CONTINUE $ WRITE(IW,5100)I9(1) $ DO 5199 K=2,4 AAMA0256 + WRITE(IW,5110)I9(K) AAMA0257 + 5199 CONTINUE $ WRITE(IW,5200)I9(1),ZSK,ZSL,ZSM,(POP(I),I=1,3) AAMA0258 + DO 5299 K=2,4 AAMA0259 + WRITE(IW,5210)I9(K),ZSK,ZSL,ZSM,(POP(I),I=1,3) AAMA0260 + 5299 CONTINUE $ WRITE(IW,5300)I9(1),(POP(I),I=4,6) $ DO 5399 K=2,4 AAMA0261 + WRITE(IW,5310)I9(K),(POP(I),I=4,6) AAMA0262 + 5399 CONTINUE $ WRITE(IW,5400)I9(1) $ DO 5499 K=2,4 AAMA0263 + WRITE(IW,5410)I9(K) AAMA0264 + 5499 CONTINUE $ WRITE(IW,5500)I9(1),IPC,WIDTHK $ DO 5599 K=2,4 AAMA0265 + WRITE(IW,5510)I9(K),IPC,WIDTHK AAMA0266 + 5599 CONTINUE $ WRITE(IW,5600)I9(1),BE $ DO 5699 K=2,4 AAMA0267 + WRITE(IW,5610)I9(K),BE AAMA0268 + 5699 CONTINUE $ WRITE(IW,5700)I9(1) $ DO 5799 K=2,4 AAMA0269 + WRITE(IW,5710)I9(K) AAMA0270 + 5799 CONTINUE $ A9 = A $ IF(AMASSA.NE.0.000) A9 = AMASSA AAMA0271 + TQM = ABS(TFM-2.3001) AAMA0272 + IF(TQM.GE.1.0E-10) WRITE(IW,5800)I9(1),A9,CFM,TFM AAMA0273 + IF(TQM.LT.1.0E-10) WRITE(IW,5820)I9(1),A9 $ DO 5899 K=2,4 AAMA0274 + IF(TQM.GE.1.0E-10) WRITE(IW,5810)I9(K),A9,CFM,TFM AAMA0275 + IF(TQM.LT.1.0E-10) WRITE(IW,5830)I9(K),A9 AAMA0276 + 5899 CONTINUE $ IF(STEP+RMATCH.GT.1.0E-20) WRITE(IW,5900)I9(1), AAMA0277 + 1 STEP,RMATCH $ IF(STEP+RMATCH.LE.1.0E-20) WRITE(IW,5920)I9(1) AAMA0278 + DO 5999 K=2,4 $ IF(STEP+RMATCH.GT.1.0E-20) WRITE(IW,5910)I9(K),AAMA0279 + 1 STEP,RMATCH $ IF(STEP+RMATCH.LE.1.0E-20) WRITE(IW,5930)I9(K) AAMA0280 + 5999 CONTINUE $ WRITE(IW,6000)I9(1),AMASSM,AMASSE,AMASSN AAMA0281 + DO 6099 K=2,4 $ WRITE(IW,6010)I9(K),AMASSM,AMASSE,AMASSN AAMA0282 + 6099 CONTINUE $ WRITE(IW,6100)I9(1),D2P1S,ESP $ DO 6199 K=2,4 AAMA0283 + WRITE(IW,6110)I9(K),D2P1S,ESP AAMA0284 + 6199 CONTINUE $ WRITE(IW,6200)I9(1) $ DO 6299 K=2,4 AAMA0285 + WRITE(IW,6210)I9(K) AAMA0286 + 6299 CONTINUE $ WRITE(IW,6300)I9(1),EHIGH,CLIMIT $ DO 6399 K=2,4 AAMA0287 + WRITE(IW,6310)I9(K),EHIGH,CLIMIT AAMA0288 + 6399 CONTINUE $ WRITE(IW,6400)I9(1),ELOW,ICC $ DO 6499 K=2,4 AAMA0289 + WRITE(IW,6410)I9(K),ELOW,ICC AAMA0290 + 6499 CONTINUE $ EAB = (EA-99.000)**2 + (EB-99.000)**2 AAMA0291 + IF(EAB.GT.1.0E-20) WRITE(IW,6500)I9(1),ERES,EA,EB AAMA0292 + IF(EAB.LE.1.0E-20) WRITE(IW,6520)I9(1),ERES $ DO 6599 K=2,4 AAMA0293 + IF(EAB.GT.1.0E-20) WRITE(IW,6510)I9(K),ERES,EA,EB AAMA0294 + IF(EAB.LE.1.0E-20) WRITE(IW,6530)I9(K),ERES AAMA0295 + 6599 CONTINUE $ WRITE(IW,6600)I9(1),CD $ DO 6699 K=2,4 AAMA0296 + WRITE(IW,6610)I9(K),CD AAMA0297 + 6699 CONTINUE $ WRITE(IW,6700)I9(1),NPOL,IPOL $ DO 6799 K=2,4 AAMA0298 + WRITE(IW,6710)I9(K),NPOL,IPOL AAMA0299 + 6799 CONTINUE $ DO 6899 K=1,4 $ WRITE(IW,6800)I9(K) AAMA0300 + 6899 CONTINUE $ DO 6999 K=1,4 $ WRITE(IW,6900)I9(K) AAMA0301 + 6999 CONTINUE $ DO 7099 K=1,4 $ WRITE(IW,7000)I9(K) AAMA0302 + 7099 CONTINUE $ WRITE(IW,7100)I9(1) $ DO 7199 K=2,4 AAMA0303 + WRITE(IW,7110)I9(K) AAMA0304 + 7199 CONTINUE $ WRITE(IW,7200)I9(1) $ DO 7299 K=2,4 AAMA0305 + WRITE(IW,7210)I9(K) AAMA0306 + 7299 CONTINUE $ WRITE(IW,7300)I9(1),K0,K1,K2,K3,IREAD,IW,IPUNCH AAMA0307 + DO 7399 K=2,4 $ WRITE(IW,7310)I9(K),K0,K1,K2,K3,IREAD,IW,IPUNCH AAMA0308 + 7399 CONTINUE $ WRITE(IW,7400)I9(1) $ DO 7499 K=2,4 AAMA0309 + WRITE(IW,7410)I9(K) AAMA0310 + 7499 CONTINUE $ DO 7599 K=1,4 $ WRITE(IW,7500)I9(K) AAMA0311 + 7599 CONTINUE $ WRITE(IW,7600)I9(1),IPRINT $ DO 7699 K=2,4 AAMA0312 + WRITE(IW,7610)I9(K),IPRINT AAMA0313 + 7699 CONTINUE $ WRITE(IW,7700)I9(1),(M9(1,J),J=1,3),IDB AAMA0314 + DO 7799 K=2,4 $ WRITE(IW,7710)I9(K),(M9(1,J),J=1,3),IDB AAMA0315 + 7799 CONTINUE $ WRITE(IW,7800)I9(1),(M9(2,J),J=1,7),IC AAMA0316 + DO 7899 K=2,4 $ WRITE(IW,7810)I9(K),(M9(2,J),J=1,7),IC AAMA0317 + 7899 CONTINUE $ WRITE(IW,7900)I9(1),(M9(3,J),J=1,7) $ DO 7999 K=2,4 AAMA0318 + WRITE(IW,7910)I9(K),(M9(3,J),J=1,7) AAMA0319 + 7999 CONTINUE $ WRITE(IW,8000)I9(1),(M9(4,J),J=1,7) $ DO 8099 K=2,4 AAMA0320 + WRITE(IW,8010)I9(K),(M9(4,J),J=1,7) AAMA0321 + 8099 CONTINUE $ WRITE(IW,8100)I9(1),FD $ DO 8199 K=2,4 AAMA0322 + WRITE(IW,8110)I9(K),FD AAMA0323 + 8199 CONTINUE $ MDIR = NMAX**2 $ WRITE(IW,8200)I9(1),IDR,MDIR AAMA0324 + DO 8299 K=2,4 $ WRITE(IW,8210)I9(K),IDR,MDIR AAMA0325 + 8299 CONTINUE $ WRITE(IW,8300)I9(1),MPU $ DO 8399 K=2,4 AAMA0326 + WRITE(IW,8310)I9(K),MPU AAMA0327 + 8399 CONTINUE $ WRITE(IW,8400)I9(1),IPN $ DO 8499 K=2,4 AAMA0328 + WRITE(IW,8410)I9(K),IPN AAMA0329 + 8499 CONTINUE $ WRITE(IW,8500)I9(1) $ DO 8599 K=2,4 AAMA0330 + WRITE(IW,8510)I9(K) AAMA0331 + 8599 CONTINUE $ DO 8699 K=1,4 $ WRITE(IW,8600)I9(K) AAMA0332 + 8699 CONTINUE $ WRITE(IW,8700)I9(1) $ DO 8799 K=2,4 AAMA0333 + WRITE(IW,8710)I9(K) AAMA0334 + 8799 CONTINUE $ WRITE(IW,8800)I9(1) $ DO 8899 K=2,4 AAMA0335 + WRITE(IW,8810)I9(K) AAMA0336 + 8899 CONTINUE $ ID9(1) = ID5 $ ID9(2) = ID4 $ ID9(3) = ID3 AAMA0337 + ID9(4) = ID2 $ ID9(5) = ID1 $ DO 8949 I=1,9 $ DO 8949 J=1,5 AAMA0338 + DO 8949 K=1,4 $ J4(I,J,K) = JB $ I99 = ID9(J) AAMA0339 + IF(MOD(J9(1,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0340 + 8949 CONTINUE $ WRITE(IW,8900)I9(1),((J4(I,J,1),I=1,9),J=1,5) AAMA0341 + DO 8999 K=2,4 $ WRITE(IW,8910)I9(K),((J4(I,J,K),I=1,9),J=1,5) AAMA0342 + 8999 CONTINUE $ DO 9049 I=1,9 $ DO 9049 J=1,5 $ DO 9049 K=1,4 AAMA0343 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0344 + IF(MOD(J9(2,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0345 + 9049 CONTINUE $ WRITE(IW,9000)I9(1),((J4(I,J,1),I=1,9),J=1,5) AAMA0346 + DO 9099 K=2,4 $ WRITE(IW,9010)I9(K),((J4(I,J,K),I=1,9),J=1,5) AAMA0347 + 9099 CONTINUE $ DO 9149 I=1,9 $ DO 9149 J=1,5 $ DO 9149 K=1,4 AAMA0348 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0349 + IF(MOD(J9(3,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0350 + 9149 CONTINUE $ WRITE(IW,9100)I9(1),JTM,((J4(I,J,1),I=1,9),J=1,5) AAMA0351 + DO9199 K=2,4 $ WRITE(IW,9110)I9(K),JTM,((J4(I,J,K),I=1,9),J=1,5)AAMA0352 + 9199 CONTINUE $ DO 9249 I=1,9 $ DO 9249 J=1,5 $ DO 9249 K=1,4 AAMA0353 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0354 + IF(MOD(J9(4,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0355 + 9249 CONTINUE $ WRITE(IW,9200)I9(1),JTD,IP1,((J4(I,J,1),I=1,9),J=1,5)AAMA0356 + DO 9299 K=2,4 AAMA0357 + WRITE(IW,9210)I9(K),JTD,IP1,((J4(I,J,K),I=1,9),J=1,5) AAMA0358 + 9299 CONTINUE $ DO 9349 I=1,9 $ DO 9349 J=1,5 $ DO 9349 K=1,4 AAMA0359 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0360 + IF(MOD(J9(5,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0361 + 9349 CONTINUE $ WRITE(IW,9300)I9(1),JTQ,IP2,((J4(I,J,1),I=1,9),J=1,5)AAMA0362 + DO 9399 K=2,4 AAMA0363 + WRITE(IW,9310)I9(K),JTQ,IP2,((J4(I,J,K),I=1,9),J=1,5) AAMA0364 + 9399 CONTINUE $ DO 9449 I=1,9 $ DO 9449 J=1,5 $ DO 9449 K=1,4 AAMA0365 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0366 + IF(MOD(J9(6,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0367 + 9449 CONTINUE $ WRITE(IW,9400)I9(1),JTO,IP3,((J4(I,J,1),I=1,9),J=1,5)AAMA0368 + DO 9499 K=2,4 AAMA0369 + WRITE(IW,9410)I9(K),JTO,IP3,((J4(I,J,K),I=1,9),J=1,5) AAMA0370 + 9499 CONTINUE $ DO 9549 I=1,9 $ DO 9549 J=1,5 $ DO 9549 K=1,4 AAMA0371 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0372 + IF(MOD(J9(7,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0373 + 9549 CONTINUE $ WRITE(IW,9500)I9(1),((J4(I,J,1),I=1,9),J=1,5) AAMA0374 + DO 9599 K=2,4 $ WRITE(IW,9510)I9(K),((J4(I,J,K),I=1,9),J=1,5) AAMA0375 + 9599 CONTINUE $ DO 9649 I=1,9 $ DO 9649 J=1,5 $ DO 9649 K=1,4 AAMA0376 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0377 + IF(MOD(J9(8,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0378 + 9649 CONTINUE $ DO 9699 K=1,4 AAMA0379 + WRITE(IW,9600)I9(K),((J4(I,J,K),I=1,9),J=1,5) AAMA0380 + 9699 CONTINUE $ DO 9749 I=1,9 $ DO 9749 J=1,5 $ DO 9749 K=1,4 AAMA0381 + J4(I,J,K) = JB $ I99 = ID9(J) AAMA0382 + IF(MOD(J9(9,I99)/2**(9-I),2).EQ.1) J4(I,J,K) = JX(K) AAMA0383 + 9749 CONTINUE $ WRITE(IW,9700)I9(1),YC,((J4(I,J,1),I=1,9),J=1,5) AAMA0384 + DO 9799 K=2,4 $ WRITE(IW,9710)I9(K),YC,((J4(I,J,K),I=1,9),J=1,5)AAMA0385 + 9799 CONTINUE $ DO 9899 K=1,4 $ WRITE(IW,9800)I9(K) AAMA0386 + 9899 CONTINUE $ DO 9999 K=1,4 $ WRITE(IW,9900)I9(K) AAMA0387 + 9999 CONTINUE $ WRITE(IW,9910) AAMA0388 + 4000 FORMAT(1H1/A1,120(1H*)) AAMA0389 + 4010 FORMAT(A1,120(1H*)) AAMA0390 + 4100 FORMAT(A1,1H*,22X,1HI,95X,1H*) AAMA0391 + 4200 FORMAT(A1,2H* ,9A1,2X,9A1,34H I TABLE OF ALL INPUT PARAMETERS -,AAMA0392 + 1 60H-- DEFAULTS (IF APPROPRIATE) FOLLOW THE VALUES, IN PARENTHES,AAMA0393 + 2 4HES *) AAMA0394 + 4210 FORMAT(A1,1H*,1X,9A1,2X,9A1,1X,1HI,95X,1H*) AAMA0395 + 4300 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,95(1H.),1H*) AAMA0396 + 4310 FORMAT(A1,1H*,1X,9A1,2X,9A1,1X,1HI,95X,1H*) AAMA0397 + 4400 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,95X,1H*) AAMA0398 + 4410 FORMAT(A1,1H*,1X,9A1,2X,9A1,1X,1HI,95X,1H*) AAMA0399 + 4500 FORMAT(A1,2H* ,9A1,2X,9A1,15H I E12 INIT. N=,I2,12H(MAX=20,DEF=,AAMA0400 + 1 23H15) E11 L-DIST. OPTION=,I2,30H(DEF=0 /-1=INPUTED,0=STATIST.,,AAMA0401 + 2 14H2=QUADRATIC) *) AAMA0402 + 4510 FORMAT(A1,1H*,1X,9A1,2X,9A1,1X,1HI,13X,I2,35X,I2,43X,1H*) AAMA0403 + 4600 FORMAT(A1,2H* 9A1,2X,9A1,24H I E12 STAT. DIST. EXP.=,F7.5, AAMA0404 + 1 25H(0.0) E14 QUAD. PARAM./A=,F7.5,8H(0.0),B=,F7.5, AAMA0405 + 2 20H(0.0) 1+A*L+B*L**2 *) AAMA0406 + 4610 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,22X,F7.5,25X,F7.5,8X,F7.5,19X, AAMA0407 + 1 1H*) AAMA0408 + 4700 FORMAT(A1,2H* ,9A1,2X,9A1,17H I E13 NORM.INIT/,F7.6,9(1X,F7.6), AAMA0409 + 1 2H *) AAMA0410 + 4710 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,15X,10(F7.6,1X),1H*) AAMA0411 + 4720 FORMAT(A1,2H* ,9A1,2X,9A1,7H I E13 ,24H L-DISTRIBUTION EXTENDS,AAMA0412 + 1 60H BEYOND STARTING N. SEE NEXT PAGE FOR COMPLETE DISTRIBUTION,AAMA0413 + 2 1H.,5X,1H*) AAMA0414 + 4730 FORMAT(A1,1H*,1X,9A1,2X,9A1,2H I,95X,1H*) AAMA0415 + 4800 FORMAT(A1,2H* ,9A1,2X,9A1,17H I L-DIST.(0-19)/,10(F7.6,1X),1H*) AAMA0416 + 4810 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,15X,10(F7.6,1X),1H*) AAMA0417 + 4820 FORMAT(A1,2H* ,9A1,2X,9A1,3H I ,4X,8(9X,1H*),10X,1H*) AAMA0418 + 4830 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,95X,1H*) AAMA0419 + 4900 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,95(1H.),1H*) AAMA0420 + 4910 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,95X,1H*) AAMA0421 + 5000 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,45X,1HI,49X,1H*) AAMA0422 + 5010 FORMAT(A1,2H* ,9A1,2X,9A1,2H I,45X,1HI,49X,1H*) AAMA0423 + 5100 FORMAT(A1,1H*,22X,42HI E07 EFFECTIVE CHARGE FOR ELECTRONIC SHEL,AAMA0424 + 1 55HLS I E08 POPUL. OF EL. SUBSHELLS (FRACTION OF FULL) *) AAMA0425 + 5110 FORMAT(A1,1H*,22X,1HI,45X,1HI,49X,1H*) AAMA0426 + 5200 FORMAT(A1,27H* E01 Z / (NEEDED) I K/,F6.3,4H, L/,F6.3,4H, M/AAMA0427 + 1 ,F6.3,21H (ALL NEEDED) I 1S=,F5.3,11H(1.000) 2S=,F5.3, AAMA0428 + 2 11H(1.000) 2P=,F5.3,9H(1.000) *) AAMA0429 + 5210 FORMAT(A1,1H*,22X,1HI,3X,F6.3,4X,F6.3,4X,F6.3,16X,1HI,4X,F5.3, AAMA0430 + 1 11X,F5.3,11X,F5.3,8X,1H*) AAMA0431 + 5300 FORMAT(A1,1H*,22(1H-),1H+,17(1H-),1H+,27(1H-),5H+ 3S=,F5.3, AAMA0432 + 1 11H(1.000) 3P=,F5.3,11H(1.000) 3D=,F5.3,9H(1.000) *) AAMA0433 + 5310 FORMAT(A1,1H*,22X,1H+,17X,1H+,27X,1H+,4X,F5.3,11X,F5.3,11X,F5.3,AAMA0434 + 1 8X,1H*) AAMA0435 + 5400 FORMAT(A1,50H* E10 DEPLETION OF ELECTRONIC SHELLS I E09 ELE,AAMA0436 + 1 20HCT. 1S WIDTH IN EV +,49(1H-),1H*) AAMA0437 + 5410 FORMAT(A1,1H*,40X,1HI,27X,1H+,49X,1H*) AAMA0438 + 5500 FORMAT(A1,1H*,5X,2HK/,I1,3H(0),6X,2HL/,I1,3H(0),6X,2HM/,I1,3H(0)AAMA0439 + 1 ,5X,1HI,6X,F7.3,9H(000.000),5X,29HI E02 AV. EL. BINDING ENER. F,AAMA0440 + 2 22HOR ATOM Z-1 (NEEDED) *) AAMA0441 + 5510 FORMAT(A1,1H*,7X,I1,11X,I1,11X,I1,8X,1HI,6X,F7.3,14X,1HI,49X,1H*AAMA0442 + 1 ) AAMA0443 + 5600 FORMAT(A1,50H* (0=YES,1=NO - IF K/0,1S WIDTH IS USED) I (EXPER.,AAMA0444 + 1 23H OR INPUTED VALUE) I K/,F9.2,8H(EV) L/,F8.2,8H(EV) M/,F8.2,AAMA0445 + 2 6H(EV) *) AAMA0446 + 5610 FORMAT(A1,1H*,40X,1HI,27X,1HI,3X,F9.2,8X,F8.2,8X,F8.2,5X,1H*) AAMA0447 + 5700 FORMAT(A1,1H*,40(1H-),1H+,27(1H-),1H+,49(1H-),1H*) AAMA0448 + 5710 FORMAT(A1,1H*,40X,1H+,27X,1H+,49X,1H*) AAMA0449 + 5800 FORMAT(A1,20H* E19 ATOMIC WEIGHT=,F6.2,21H(140.00) E23 FERMI PA,AAMA0450 + 1 34HRAMETERS (NOT USED IN PROGRAM) C=,F7.5,17H(FM),SKIN THICK. ,AAMA0451 + 2 2HT=,F7.5,6H(FM) *) AAMA0452 + 5810 FORMAT(A1,1H*,19X,F6.2,55X,F7.5,19X,F7.5,5X,1H*) AAMA0453 + 5820 FORMAT(A1,20H* E19 ATOMIC WEIGHT=,F6.2,21H(140.00) E23 FERMI PA,AAMA0454 + 1 60HRAMETERS (NOT USED IN PROGRAM) * * N O T S P E C I F I,AAMA0455 + 2 13H E D * * *) AAMA0456 + 5830 FORMAT(A1,1H*,19X,F6.2,93X,1H*) AAMA0457 + 5900 FORMAT(A1,50H* E24 /DIRAC/ PROGRAM PARAMETERS(NOT USED)/ STEP I,AAMA0458 + 1 14HN INTEGRATION=,1PE9.3,17H MATCHING RADIUS=,E9.3, AAMA0459 + 2 21H(FM)(FOR REFERENCE) *) AAMA0460 + 5910 FORMAT(A1,1H*,63X,1PE9.3,17X,E9.3,20X,1H*) AAMA0461 + 5920 FORMAT(A1,50H* E24 /DIRAC/ PROGRAM PARAMETERS(NOT USED)/ * *,AAMA0462 + 1 46H N O T S P E C I F I E D *,8(2X,1H*)) AAMA0463 + 5930 FORMAT(A1,1H*,118X,1H*) AAMA0464 + 6000 FORMAT(A1,23H* E30 MASSES/ PARTICLE=,F9.4,18H(206.7686)(ELEC. M,AAMA0465 + 1 17HASSES) ELECTRON=,F8.1,24H(511003.4)(EV) NUCLEON=,F6.2, AAMA0466 + 2 15H(931.48)(MEV) *) AAMA0467 + 6010 FORMAT(A1,1H*,22X,F9.4,35X,F8.1,24X,F6.2,14X,1H*) AAMA0468 + 6100 FORMAT(A1,50H* E06,E07 SPECIAL EXPERIM. TRANSITION ENERGIES/ 2,AAMA0469 + 1 5HP-1S=,-6PF8.6,25H(EMPIR. FIT)(MEV) 2S-2P=,F8.6,10H(0.0/NO TR,AAMA0470 + 2 14HANSIT.)(MEV) *) AAMA0471 + 6110 FORMAT(A1,1H*,54X,-6PF8.6,25X,F8.6,23X,1H*) AAMA0472 + 6200 FORMAT(A1,1H*,12(1H-),1H+,31(1H-),1H+,55(1H-),1H+,17(1H-),1H*) AAMA0473 + 6210 FORMAT(A1,1H*,12X,1H+,31X,1H+,55X,1H+,17X,1H*) AAMA0474 + 6300 FORMAT(A1,1H*,12X,14H/ E20 HI. CUT=,F6.3,17H(20.000)MEV I E21, AAMA0475 + 1 16H INTENS. CUTOFF=,1PE9.3,33H(1.000E-06)(PER PARTICLE) I E33 S,AAMA0476 + 2 12HTAR OPTION *) AAMA0477 + 6310 FORMAT(A1,1H*,12X,1H/,13X,F6.3,12X,1HI,20X,1PE9.3,26X,1HI,17X, AAMA0478 + 1 1H*) AAMA0479 + 6400 FORMAT(A1,27H* CATALOGUE / E20 LOW CUT=,F6.3,14H( 0.040)MEV I ,AAMA0480 + 1 60HE25 CALIBRATION PARAMETERS (CONVERSION TO CHANNEL NO) I IN C,AAMA0481 + 2 7HATALOG/,I1,5H(0) *) AAMA0482 + 6410 FORMAT(A1,1H*,12X,1H/,13X,F6.3,12X,1HI,55X,1HI,12X,I1,4X,1H*) AAMA0483 + 6500 FORMAT(A1,27H* PARAMETERS / E22 RESOL. =,F6.5,13H(.00030)MEV I, AAMA0484 + 1 5X,2HA=,F7.2,11H (KEV) , B=,F7.3,27H CHANNEL NO =(E-A)/B) I 0=,AAMA0485 + 2 15HDEF, 1=READIN *) AAMA0486 + 6510 FORMAT(A1,1H*,12X,1H/,13X,F6.5,12X,1HI,7X,F7.2,11X,F7.3,23X, AAMA0487 + 1 1HI,17X,1H*) AAMA0488 + 6520 FORMAT(A1,27H* PARAMETERS / E22 RESOL. =,F6.5,13H(.00030)MEV I, AAMA0489 + 1 5X,57H * * N O T S P E C I F I E D * * * * I 0=DEF,AAMA0490 + 2 12H, 1=READIN *) AAMA0491 + 6530 FORMAT(A1,1H*,12X,1H/,13X,F6.5,12X,1HI,55X,1HI,17X,1H*) AAMA0492 + 6600 FORMAT(A1,1H*,12X,24H/ E34 INTENSITIES / 5*=,1PE7.1,8H(.1) 4*=,AAMA0493 + 1 E7.1,9H(.01) 3*=,E7.1,10H(.001) 2*=,E7.1,11H(.0001) 1*=,E7.1, AAMA0494 + 2 10H(.00001) *) AAMA0495 + 6610 FORMAT(A1,1H*,12X,1H/,23X,1PE7.1,8X,E7.1,9X,E7.1,10X,E7.1,11X, AAMA0496 + 1 E7.1,9X,1H*) AAMA0497 + 6700 FORMAT(A1,18H* E17,E18 QUAN.DEP,4(1H/,I2,1H,,I2,1H,,I2,1H,,I2, AAMA0498 + 1 1H,,I2),28H(ALL/-1=START RAN) DO DEPOL=,I1,13H(0/0=Y,1=N) *) AAMA0499 + 6710 FORMAT(A1,1H*,17X,20(1X,I2),28X,I1,12X,1H*) AAMA0500 + 6800 FORMAT(A1,1H*,118X,1H*) AAMA0501 + 6900 FORMAT(A1,120(1H*)) AAMA0502 + 7000 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0503 + 7100 FORMAT(A1,50H* S H E L L A N D S U B S H E L L C O M B I N ,AAMA0504 + 1 60HA T I O N S I B O O K K E E P I N G P A R A M E T E,AAMA0505 + 2 10H R S *) AAMA0506 + 7110 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0507 + 7200 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0508 + 7210 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0509 + 7300 FORMAT(A1,16H* E38 CASES/ M/,I1,16H(MAX=3,DEF=3),D/,I1,3H,Q/, AAMA0510 + 1 I1,3H,O/,I1,48H (D,Q,O/MAX=7,DEF=4) I E31 LOGICAL UNIT NO.S REA,AAMA0511 + 2 2HD=,I1,10H(5),WRITE=,I1,10H(6),PUNCH=,I1,5H(7) *) AAMA0512 + 7310 FORMAT(A1,1H*,15X,I1,16X,I1,3X,I1,3X,I1,21X,1HI,28X,I1,10X,I1, AAMA0513 + 1 10X,I1,4X,1H*) AAMA0514 + 7400 FORMAT(A1,1H*,62(1H.),1HI,55(1H.),1H*) AAMA0515 + 7410 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0516 + 7500 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0517 + 7600 FORMAT(A1,8H* E39,40,1X,2HC1,6X,2HC2,6X,2HC3,6X,2HC4,6X,2HC5,6X,AAMA0518 + 1 2HC6,6X,2HC7,4X,20HI E35 PRINT OPTION =,I2,17H(0/PRINT ALL) SEL,AAMA0519 + 2 18HECT CODES 0 - 63 *) AAMA0520 + 7610 FORMAT(A1,1H*,62X,1HI,19X,I2,34X,1H*) AAMA0521 + 7700 FORMAT(A1,7H* MON/ ,A2,6H(1S) ,A2,6H(2T) ,A2,13H(3T) ------ ,AAMA0522 + 1 46H ------ ------ ------ I E36 DEBUG OPTION = ,I1, AAMA0523 + 2 35H(0)(0=N,1=Y) DEB PRINTS ALL RATES *) AAMA0524 + 7710 FORMAT(A1,1H*,6X,A2,6X,A2,6X,A2,38X,1HI,20X,I1,34X,1H*) AAMA0525 + 7800 FORMAT(A1,7H* DIP/ ,A2,6H(RD)* ,A2,6H(1S) ,A2,6H(2T) ,A2, AAMA0526 + 1 6H(3T) ,3(A2,6H(--) ),21HI E32 ACCURACY CHECK=,I1, AAMA0527 + 2 35H(3)(0=NO, 1 OR 2=PARTIAL, 3=FULL) *) AAMA0528 + 7810 FORMAT(A1,1H*,6X,7(A2,6X),1HI,20X,I1,34X,1H*) AAMA0529 + 7900 FORMAT(A1,7H* QUA/ ,A2,6H(RD)* ,A2,6H(1S) ,A2,6H(2T) ,A2, AAMA0530 + 1 6H(3T) ,3(A2,6H(--) ),1HI,55(1H.),1H*) AAMA0531 + 7910 FORMAT(A1,1H*,6X,7(A2,6X),1HI,55X,1H*) AAMA0532 + 8000 FORMAT(A1,7H* OCT/ ,A2,6H(RD)* ,A2,6H(1S) ,A2,6H(2T) ,A2, AAMA0533 + 1 6H(3T) ,3(A2,6H(--) ),1HI,55X,1H*) AAMA0534 + 8010 FORMAT(A1,1H*,6X,7(A2,6X),1HI,55X,1H*) AAMA0535 + 8100 FORMAT(A1,50H* KEY/ RD=RADIAT., T=TOTAL SHELL, --=NOT APPLIC., ,AAMA0536 + 1 30H*=MUST BE RD I E37 FACT. DIV.=,F5.2,21H(15.00) FACT. STORED ,AAMA0537 + 2 14HFAC(N)/FD**N *) AAMA0538 + 8110 FORMAT(A1,1H*,62X,1HI,16X,F5.2,34X,1H*) AAMA0539 + 8200 FORMAT(A1,1H*,62X,36HI E36 NO. OF DIRAC ENERGIES INPUTED=,I3, AAMA0540 + 1 8H OUT OF ,I3,7H MAX. *) AAMA0541 + 8210 FORMAT(A1,1H*,62X,1HI,35X,I3,8X,I3,6X,1H*) AAMA0542 + 8300 FORMAT(A1,63(1H*),37HI E27 MAX NO. OF TRANSITIONS PUNCHED=,I3, AAMA0543 + 1 17H(MAX=200,DEF=0) *) AAMA0544 + 8310 FORMAT(A1,63(1H*),1HI,36X,I3,16X,1H*) AAMA0545 + 8400 FORMAT(A1,1H*,62X,39HI E29 PUNCH SPECIFIED TRANSITIONS / ,I1,AAMA0546 + 1 17H(0 =YES, 1 =NO) *) AAMA0547 + 8410 FORMAT(A1,1H*,62X,1HI,38X,I1,16X,1H*) AAMA0548 + 8500 FORMAT(A1,1H*,6X,43HS E L E C T I O N O F P E N E T R A T,AAMA0549 + 1 6H I O N,7X,1HI,55(1H.),1H*) AAMA0550 + 8510 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0551 + 8600 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0552 + 8700 FORMAT(A1,50H* E42 MAX NUMBER OF TERMS IN I E41 PENETRATION SEL,AAMA0553 + 1 60HECTION CODES I E28 PUNCHED CARD IDENTITY NO. IN COL.S 73-78 ,AAMA0554 + 2 10H/(10000) *) AAMA0555 + 8710 FORMAT(A1,1H*,28X,1HI,33X,1HI,55X,1H*) AAMA0556 + 8800 FORMAT(A1,50H* PENETRATION (MAX=3,DEF.=1) I (1=Y,0=N *=MUST,AAMA0557 + 1 14H BE 0,DEF=1) I,55X,1H*) AAMA0558 + 8810 FORMAT(A1,1H*,28X,1HI,33X,1HI,55X,1H*) AAMA0559 + 8900 FORMAT(A1,1H*,28X,17HI CASES AS IN E26,17X,1HI,5(1X,9A1,1X),1H*)AAMA0560 + 8910 FORMAT(A1,1H*,28X,1HI,33X,1HI,5(1X,9A1,1X),1H*) AAMA0561 + 9000 FORMAT(A1,50H* 1S 2S 2P 3S 3P 3D I C1 C2 C3 C4,AAMA0562 + 1 14H C5 C6 C7 I,5(1X,9A1,1X),1H*) AAMA0563 + 9010 FORMAT(A1,1H*,28X,1HI,33X,1HI,5(1X,9A1,1X),1H*) AAMA0564 + 9100 FORMAT(A1,4H* M/,1X,6(1X,I1,2X),5HI M/,5H - ,6(2X,1H-,1X),1HIAAMA0565 + 1 ,5(1X,9A1,1X),1H*) AAMA0566 + 9110 FORMAT(A1,1H*,4X,6(1X,I1,2X),1HI,33X,1HI,5(1X,9A1,1X),1H*) AAMA0567 + 9200 FORMAT(A1,5H* D/ ,6(1X,I1,2X),7HI D/ ,I1,1H*,6(3X,I1),2H I, AAMA0568 + 1 5(1X,9A1,1X),1H*) AAMA0569 + 9210 FORMAT(A1,1H*,4X,6(1X,I1,2X),1HI,6X,I1,1X,6(3X,I1),2H I, AAMA0570 + 1 5(1X,9A1,1X),1H*) AAMA0571 + 9300 FORMAT(A1,5H* Q/ ,6(1X,I1,2X),7HI Q/ ,I1,1H*,6(3X,I1),2H I, AAMA0572 + 1 5(1X,9A1,1X),1H*) AAMA0573 + 9310 FORMAT(A1,1H*,4X,6(1X,I1,2X),1HI,6X,I1,1X,6(3X,I1),2H I, AAMA0574 + 1 5(1X,9A1,1X),1H*) AAMA0575 + 9400 FORMAT(A1,5H* O/ ,6(1X,I1,2X),7HI O/ ,I1,1H*,6(3X,I1),2H I, AAMA0576 + 1 5(1X,9A1,1X),1H*) AAMA0577 + 9410 FORMAT(A1,1H*,4X,6(1X,I1,2X),1HI,6X,I1,1X,6(3X,I1),2H I, AAMA0578 + 1 5(1X,9A1,1X),1H*) AAMA0579 + 9500 FORMAT(A1,1H*,28(1H.),1HI,33(1H.),1HI,5(1X,9A1,1X),1H*) AAMA0580 + 9510 FORMAT(A1,1H*,28X,1HI,33X,1HI,5(1X,9A1,1X),1H*) AAMA0581 + 9600 FORMAT(A1,1H*,62X,1HI,5(1X,9A1,1X),1H*) AAMA0582 + 9700 FORMAT(A1,17H* E43 Y-CUTOFF M/,F5.2,3H D/,F5.2,3H Q/,F5.2,3H O/,AAMA0583 + 1 F5.2,18H (ALL DEF/ 1.00) I,5(1X,9A1,1X),1H*) AAMA0584 + 9710 FORMAT(A1,1H*,16X,F5.2,3(3X,F5.2),17X,1HI,5(1X,9A1,1X),1H*) AAMA0585 + 9800 FORMAT(A1,1H*,62X,1HI,55X,1H*) AAMA0586 + 9900 FORMAT(A1,120(1H*)) AAMA0587 + 9910 FORMAT(1H1) AAMA0588 + IF(IP8.EQ.0) GO TO 11100 $ WRITE(IW,10000) AAMA0589 + WRITE(IW,10100) $ WRITE(IW,10200) $ DO 10199 I=1,NMAX AAMA0590 + N = NMAX + 1 -I $ SS =0.000 $ DO 10099 J=1,N $ K = N*(N-1)/2 + JAAMA0591 + PLX(J) = PLN(K) $ SS = SS + PLX(J) $ K = IFIX(PLX(J)*1.0E6+0.50)AAMA0592 + IXX(1,J) = MOD(K/100,10) $ IXX(2,J) = MOD(K/10,10) AAMA0593 + IXX(3,J) = MOD(K,10) AAMA0594 + IF(AMOD(1000.0*PLX(J),1.0).GT..499999) PLX(J)=PLX(J)-.000499999AAMA0595 + IF(PLX(J).LT.0.000) PLX(J) = 0.000 AAMA0596 +10099 CONTINUE $ IF(N.GT.2) WRITE(IW,10300)N,SS,(PLX(J),J=1,N) AAMA0597 + IF(N.EQ.2) WRITE(IW,10600)N,SS,(PLX(J),J=1,2) AAMA0598 + IF(N.EQ.1) WRITE(IW,10900)N,SS,PLX(1) AAMA0599 + IF(N.GT.2) WRITE(IW,10400)((IXX(II,J),II=1,3),J=1,N) AAMA0600 + IF(N.EQ.2) WRITE(IW,10700)((IXX(II,J),II=1,3),J=1,2) AAMA0601 + IF(N.EQ.1) WRITE(IW,11000)(IXX(II,1),II=1,3) AAMA0602 + IF(N.GT.15) WRITE(IW,10450) AAMA0603 + IF(N.GT.10.AND.N.LE.15) WRITE(IW,10460) AAMA0604 + IF(N.GT.5.AND.N.LE.10) WRITE(IW,10470) AAMA0605 + IF(N.LE.5.AND.N.GT.3) WRITE(IW,10480) AAMA0606 + IF(N.EQ.3) WRITE(IW,10500) $ IF(N.EQ.2) WRITE(IW,10800) AAMA0607 +10199 CONTINUE AAMA0608 +10000 FORMAT(20X,49H* * N O R M A L I Z E D I N I T I A L L - ,AAMA0609 + 1 30HD I S T R I B U T I O N * */) AAMA0610 +10100 FORMAT(7X,50HTOTAL I L=0 L=1 L=2 L=3 L=4 I L=5 L=6 L=7,AAMA0611 + 1 60H L=8 L=9 I L=10 L=11 L=12 L=13 L=14 I L=15 L=16 L=17 L=18 ,AAMA0612 + 2 4HL=19) AAMA0613 +10200 FORMAT(1X,13(1H-),1H+,26(1H-),1H+,26(1H-),1H+,26(1H-),1H+,26(1H-AAMA0614 + 1 )) AAMA0615 +10300 FORMAT(3H N=,I2,1X,F7.5,4(2H I,1X,F4.3,1X,F4.3,1X,F4.3,1X,F4.3, AAMA0616 + 1 1X,F4.3)) AAMA0617 +10400 FORMAT(13X,4(2H I,2X,3I1,2X,3I1,2X,3I1,2X,3I1,2X,3I1)) AAMA0618 +10450 FORMAT(14X,1HI,26X,1HI,26X,1HI,26X,1HI) AAMA0619 +10460 FORMAT(14X,1HI,26X,1HI,26X,1HI) AAMA0620 +10470 FORMAT(14X,1HI,26X,1HI) AAMA0621 +10480 FORMAT(14X,1HI) AAMA0622 +10500 FORMAT(14X,1HI,56X,1H+,32(1H-),1H+) AAMA0623 +10600 FORMAT(3H N=,I2,1X,F7.5,3H I ,F4.3,1X,F4.3,46X,1HI,32X,1HI) AAMA0624 +10700 FORMAT(14X,1HI,2X,3I1,2X,3I1,46X,27HI ENTRIES FOLDED .ABC = .A,AAMA0625 + 1 7HBCDEF I) AAMA0626 +10800 FORMAT(14X,1HI,56X,34HI TO SAVE SPACE DEF I) AAMA0627 +10900 FORMAT(3H N=,I2,F8.5,3H I ,F4.3,51X,1HI,32X,1HI) AAMA0628 +11000 FORMAT(14X,1HI,2X,3I1,51X,1H+,32(1H-),1H+/1H1) AAMA0629 +11100 CALL CASCAD $ CALL SORT $ GO TO 1175 $ END AAMA0630 +C-----------------------------------------------------------------------AAMA0631 + 0 SUBROUTINE RREAD $ INTEGER A,S,B $ DOUBLE PRECISION F AAMA0632 +C *** READS INPUT CARDS AND SETS PARAMETERS ACCORDING TO CODES AAMA0633 + DIMENSION A(89),S(70) AAMA0634 + COMMON/LOC001/IJK,ENERG,ECONS,ECONST,D2P1SM,D2P1S AAMA0635 + COMMON/LOC002/BEM(3),ZSA(3),BE(3) $ COMMON/LOC003/K0,K1,K2,K3 AAMA0636 + COMMON/LOC004/NN0(3),NN1(7),NN2(7),NN3(7) AAMA0637 + COMMON/LOC006/IP1(7),IP2(7),IP3(7),IQ1(7),IQ2(7),IQ3(7) AAMA0638 + COMMON/LOC007/IC $ COMMON/LOC008/IR,IW,IPUNCH,IPRINT AAMA0639 + COMMON/LOC009/F(60),FD AAMA0640 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA0641 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA0642 + COMMON/LOC017/IFM(6) $ COMMON/LOC018/IFD(9) AAMA0643 + COMMON/LOC019/IFQ(10) $ COMMON/LOC020/IFO(10) AAMA0644 + COMMON/LOC028/M1(7),M2(7),M3(7),YC(4),IDB AAMA0645 + COMMON/LOC030/POP(6),JTM(6),JTD(6),JTQ(6),JTO(6) AAMA0646 + COMMON/LOC031/JM(10),JD(14),JQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA0647 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA0648 + COMMON/LOC033/M,E(1000),AI(1000),IA(1000),ENERGY(20,40) AAMA0649 + COMMON/LOC035/ICC,CD(5),EA,EB,IDR AAMA0650 + COMMON/LOC036/ZMK,ZML,ZMM,ZMKM,ZMLM,ZMMM,IVERS AAMA0651 + COMMON/LOC037/PL(20),NPOL(20),IPOL,CL1,CL2,IDE,PLN(210),IP8 AAMA0652 + COMMON/LOC038/AA,CFM,TFM,STEP,RMATCH,WIDTHK,IPC(3) AAMA0653 + COMMON/LOC039/NOPT,NMAX,ALEXP $ COMMON/LOC040/AMASSA,AMASSN,HBARAAMA0654 + COMMON/LOC041/MPU,ICPU(200),IPN $ DATA T8/0.000/ AAMA0655 + DATA A/3HIJK,3HENE,3HAMA,3HAMN,3HD21,3HBE ,3HK ,3HNN0,3HNN1, AAMA0656 + 1 3HNN2,3HNN3,3HIP1,3HIP2,3HIP3,3HIC ,3HIRE,3HIWR,3HIPU,3HFD , AAMA0657 + 2 3HAMM,3HAME,3HZ ,3HZS ,3HIFM,3HIFD,3HIFQ,3HIFO,3HM1 ,3HM2 , AAMA0658 + 3 3HM3 ,3HPOP,3HJM ,3HJD ,3HJQ ,3HJO ,3HEHI,3HELO,3HCLM,3HERS, AAMA0659 + 4 3HICC,3HCD ,3HEAB,3HSTO,3HC ,3HXEQ,3HA ,3HCT ,3HSTP,3HKWD, AAMA0660 + 5 3HNOP,3HNMX,3HPL ,3HDIR,3HIPR,3HNPL,3HIPL,3HZM ,3HZMM,3HIQ1, AAMA0661 + 6 3HIQ2,3HIQ3,3HIDB,3HYC ,3HIYC,3HIJ ,3HYJ ,3HJJ1,3HIPC,3HCL , AAMA0662 + 7 3HESP,3HPUN,3HIDE,3HIPN,3HJTM,3HJTD,3HJTQ,3HJTO,3HPLN,3HIP , AAMA0663 + 8 3H ,3H ,3H ,3H ,3H ,3H ,3H ,3H ,3H ,3H / AAMA0664 + DATA IRC/0/ $ IF(IRC.EQ.0) MPU = 0 $ IF(IRC.NE.0) WRITE(IW,50)AAMA0665 + 50 FORMAT(//51H *** NEW CASE COMING UP *** READING UNTIL XEQ *** )AAMA0666 +C.......................................................................AAMA0667 +C *** ...... THIS IS A BKY CDC FEATURE FOR TIME - CHANGE OR DELETE ...AAMA0668 + CALL SECOND(T9) $ D8=T9-T8 $ T8=T9 $ WRITE(IW,75)D8 AAMA0669 + 75 FORMAT(1X,20(1H.),35H INCREMENTAL TIME SINCE LAST CALL =,3PF7.0,AAMA0670 + 1 8H (MSEC) ,20(1H.)) AAMA0671 +C.......................................................................AAMA0672 + 100 IRC = IRC+1 $ READ(IR,200)B,B1,B2,S AAMA0673 + 200 FORMAT(A3,A3,A4,70A1) AAMA0674 + 0 IF(MOD(IPRINT/2,2).EQ.0) WRITE(IW,300)IRC,B,B1,B2,S AAMA0675 + 300 FORMAT(1X,14HINPUT CARD NO.,I3,5X,3H---,5X,2A3,A4,70A1) AAMA0676 + 0 J = 0 $ DO 400 I=1,89 $ IF(B.EQ.A(I)) J=I AAMA0677 + IF(J.NE.0) GO TO 600 AAMA0678 + 400 CONTINUE $ WRITE(IW,500)B AAMA0679 + 500 FORMAT(/46H *** ERROR *** INPUT ACTION CODE ILLEGAL *** =,A3, AAMA0680 + 1 21H *** CARD IGNORED ***) AAMA0681 + 0 GO TO 100 AAMA0682 + 600 JT = J/10 + 1 $ JU = MOD(J,10) + 1 $ NI = 1 AAMA0683 + GO TO(999,1999,2999,3999,4999,5999,6999,7999,8999),JT AAMA0684 + 900 FORMAT(53H *** WARNING *** UNIMPLEMENTED USER CODE FOR THIS VER,AAMA0685 + 1 29HSION (NO EFFECT PRODUCED) ***) AAMA0686 + 999 GO TO (100,1100,1200,1300,1400,1500,1600,1700,1800,1900),JU AAMA0687 + 1100 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0688 + CALL DCYPHR(S,NI,0,DUM,IJK) $ GO TO 100 AAMA0689 + 1200 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0690 + CALL DCYPHR(S,NI,1,ENERG,IDUM) $ GO TO 100 AAMA0691 + 1300 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0692 + CALL DCYPHR(S,NI,1,AMASSA,IDUM) $ WRITE(IW,1350) AAMA0693 + 1350 FORMAT(53H *** WARNING *** AMASSA HAS BEEN PROVIDED -- IF NEW A,AAMA0694 + 1 51H NEW AMASSA MUST BE GIVEN (OR ZERO FOR DEFAULT) ***) AAMA0695 + 0 GO TO 100 AAMA0696 + 1400 CALL DCYPHR(S,NI,1,AMASSN,IDUM) $ GO TO 100 AAMA0697 + 1500 CALL DCYPHR(S,NI,1,D2P1S,IDUM) $ GO TO 100 AAMA0698 + 1600 DO 1650 K=1,3 $ CALL DCYPHR(S,NI,1,BE(K),IDUM) AAMA0699 + 1650 CONTINUE $ GO TO 100 AAMA0700 + 1700 CALL DCYPHR(S,NI,0,DUM,K0) $ CALL DCYPHR(S,NI,0,DUM,K1) AAMA0701 + CALL DCYPHR(S,NI,0,DUM,K2) $ CALL DCYPHR(S,NI,0,DUM,K3) AAMA0702 + GO TO 100 AAMA0703 + 1800 DO 1850 K=1,K0 $ CALL DCYPHR(S,NI,0,DUM,NN0(K)) AAMA0704 + 1850 CONTINUE $ GO TO 100 AAMA0705 + 1900 DO 1950 K=1,K1 $ CALL DCYPHR(S,NI,0,DUM,NN1(K)) AAMA0706 + 1950 CONTINUE $ IF(NN1(1).NE.0) WRITE(IW,1975) $ GO TO 100 AAMA0707 + 1975 FORMAT(53H *** ERROR *** RADIARION IS NOT COMPUTED AS THE FIRST,AAMA0708 + 1 60H ITEM IN THE MULTIPOLARITY *** NO ACTION TAKEN BUT RESULTS A,AAMA0709 + 2 8HRE BAD *) AAMA0710 + 1999 GO TO (2000,2100,2200,2300,2400,2500,2600,2700,2800,2900),JU AAMA0711 + 2000 DO 2050 K=1,K2 $ CALL DCYPHR(S,NI,0,DUM,NN2(K)) AAMA0712 + 2050 CONTINUE $ IF(NN2(1).NE.0) WRITE(IW,1975) $ GO TO 100 AAMA0713 + 2100 DO 2150 K=1,K3 $ CALL DCYPHR(S,NI,0,DUM,NN3(K)) AAMA0714 + 2150 CONTINUE $ IF(NN3(1).NE.0) WRITE(IW,1975) $ GO TO 100 AAMA0715 + 2200 DO 2250 K=1,K1 $ CALL DCYPHR(S,NI,0,DUM,IP1(K)) AAMA0716 + 2250 CONTINUE $ IF(IP1(1).NE.0) WRITE(IW,2275) $ GO TO 100 AAMA0717 + 2275 FORMAT(53H *** ERROR *** ILLEGAL CODE FOR PENETRATION IN RADIAT,AAMA0718 + 1 60HION (1ST ENTRY MUST BE 0) *** NO ACTION TAKEN, BUT RESULTS A,AAMA0719 + 2 8HRE BAD *) AAMA0720 + 2300 DO 2350 K=1,K2 $ CALL DCYPHR(S,NI,0,DUM,IP2(K)) AAMA0721 + 2350 CONTINUE $ IF(IP2(1).NE.0) WRITE(IW,2275) $ GO TO 100 AAMA0722 + 2400 DO 2450 K=1,K3 $ CALL DCYPHR(S,NI,0,DUM,IP3(K)) AAMA0723 + 2450 CONTINUE $ IF(IP3(1).NE.0) WRITE(IW,2275) $ GO TO 100 AAMA0724 + 2500 CALL DCYPHR(S,NI,0,DUM,IC) $ GO TO 100 AAMA0725 + 2600 CALL DCYPHR(S,NI,0,DUM,IR) $ GO TO 100 AAMA0726 + 2700 CALL DCYPHR(S,NI,0,DUM,IW) $ GO TO 100 AAMA0727 + 2800 CALL DCYPHR(S,NI,0,DUM,IPUNCH) $ GO TO 100 AAMA0728 + 2900 CALL DCYPHR(S,NI,1,FD,IDUM) $ GO TO 100 AAMA0729 + 2999 GO TO (3000,3100,3200,3300,3400,3500,3600,3700,3800,3900),JU AAMA0730 + 3000 CALL DCYPHR(S,NI,1,AMASSM,IDUM) $ GO TO 100 AAMA0731 + 3100 CALL DCYPHR(S,NI,1,AMASSE,IDUM) $ GO TO 100 AAMA0732 + 3200 CALL DCYPHR(S,NI,1,Z,IDUM) $ GO TO 100 AAMA0733 + 3300 CALL DCYPHR(S,NI,1,ZSK,IDUM) $ CALL DCYPHR(S,NI,1,ZSL,IDUM) AAMA0734 + CALL DCYPHR(S,NI,1,ZSM,IDUM) $ GO TO 100 AAMA0735 + 3400 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0736 + DO 3450 K=1,6 $ CALL DCYPHR(S,NI,0,DUM,IFM(K)) AAMA0737 + 3450 CONTINUE $ GO TO 100 AAMA0738 + 3500 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0739 + DO 3550 K=1,9 $ CALL DCYPHR(S,NI,0,DUM,IFD(K)) AAMA0740 + 3550 CONTINUE $ GO TO 100 AAMA0741 + 3600 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0742 + DO 3650 K=1,10 $ CALL DCYPHR(S,NI,0,DUM,IFQ(K)) AAMA0743 + 3650 CONTINUE $ GO TO 100 AAMA0744 + 3700 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0745 + DO 3750 K=1,10 $ CALL DCYPHR(S,NI,0,DUM,IFO(K)) AAMA0746 + 3750 CONTINUE $ GO TO 100 AAMA0747 + 3800 DO 3850 K=1,K1 $ CALL DCYPHR(S,NI,0,DUM,M1(K)) AAMA0748 + 3850 CONTINUE $ GO TO 100 AAMA0749 + 3900 DO 3950 K=1,K2 $ CALL DCYPHR(S,NI,0,DUM,M2(K)) AAMA0750 + 3950 CONTINUE $ GO TO 100 AAMA0751 + 3999 GO TO (4000,4100,4200,4300,4400,4500,4600,4700,4800,4900),JU AAMA0752 + 4000 DO 4050 K=1,K3 $ CALL DCYPHR(S,NI,0,DUM,M3(K)) AAMA0753 + 4050 CONTINUE $ GO TO 100 AAMA0754 + 4100 DO 4150 K=1,6 $ CALL DCYPHR(S,NI,1,POP(K),IDUM) AAMA0755 + IF(POP(K).LT.0.000) WRITE(IW,4110)K,POP(K) AAMA0756 + 4110 FORMAT(21H *** WARNING *** POP(,I1,3H) =,F6.3,14H *** SET TO 1.,AAMA0757 + 1 7H000 ***) AAMA0758 + IF(POP(K).LT.0.000) POP(K) = 0.000 AAMA0759 + IF(POP(K).GT.1.000) WRITE(IW,4120)K,POP(K) AAMA0760 + 4120 FORMAT(21H *** WARNING *** POP(,I1,3H) =,F6.3,14H *** SET TO 0.,AAMA0761 + 1 7H000 ***) AAMA0762 + IF(POP(K).GT.1.000) POP(K) = 1.000 AAMA0763 + 4150 CONTINUE $ GO TO 100 AAMA0764 + 4200 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0765 + DO 4250 K=1,10 $ CALL DCYPHR(S,NI,0,DUM,JM(K)) AAMA0766 + 4250 CONTINUE $ GO TO 100 AAMA0767 + 4300 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVRES.NE.1) GO TO 100 AAMA0768 + DO 4350 K=1,14 $ CALL DCYPHR(S,NI,0,DUM,JD(K)) AAMA0769 + 4350 CONTINUE $ GO TO 100 AAMA0770 + 4400 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0771 + DO 4450 K=1,15 $ CALL DCYPHR(S,NI,0,DUM,JQ(K)) AAMA0772 + 4450 CONTINUE $ GO TO 100 AAMA0773 + 4500 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0774 + DO 4550 K=1,15 $ CALL DCYPHR(S,NI,0,DUM,JO(K)) AAMA0775 + 4550 CONTINUE $ GO TO 100 AAMA0776 + 4600 CALL DCYPHR(S,NI,1,EHIGH,IDUM) $ GO TO 100 AAMA0777 + 4700 CALL DCYPHR(S,NI,1,ELOW,IDUM) $ GO TO 100 AAMA0778 + 4800 CALL DCYPHR(S,NI,1,CLIMIT,IDUM) $ GO TO 100 AAMA0779 + 4900 CALL DCYPHR(S,NI,1,ERES,IDUM) $ GO TO 100 AAMA0780 + 4999 GO TO (5000,5100,5200,5300,100,5500,5600,5700,5800,5900),JU AAMA0781 + 5000 CALL DCYPHR(S,NI,0,DUM,ICC) $ GO TO 100 AAMA0782 + 5100 DO 5150 K=1,5 $ CALL DCYPHR(S,NI,1,CD(K),IDUM) AAMA0783 + 5150 CONTINUE $ GO TO 100 AAMA0784 + 5200 CALL DCYPHR(S,NI,1,EA,IDUM) $ CALL DCYPHR(S,NI,1,EB,IDUM) AAMA0785 + GO TO 100 AAMA0786 + 5300 WRITE(IW,5350) $ STOP AAMA0787 + 5350 FORMAT(53H *** STOP CARD ENCOUNTERED IN THE INPUT FILE *** EXEC,AAMA0788 + 1 60HTION TERMINATED NORMALLY *** NO SUBSEQUENT INPUT CARDS (IF A,AAMA0789 + 2 8HNY) READ) AAMA0790 + 5500 GO TO 10000 AAMA0791 + 5600 CALL DCYPHR(S,NI,1,AA,IDUM) $ GO TO 100 AAMA0792 + 5700 CALL DCYPHR(S,NI,1,CFM,IDUM) $ CALL DCYPHR(S,NI,1,TFM,IDUM) AAMA0793 + GO TO 100 AAMA0794 + 5800 CALL DCYPHR(S,NI,1,STEP,IDUM) $ CALL DCYPHR(S,NI,1,RMATCH,IDUM) AAMA0795 + GO TO 100 AAMA0796 + 5900 CALL DCYPHR(S,NI,1,WIDTHK,IDUM) $ GO TO 100 AAMA0797 + 5999 GO TO (6000,6100,6200,6300,6400,6500,6600,6700,6800,6900),JU AAMA0798 + 6000 CALL DCYPHR(S,NI,0,DUM,NOPT) $ GO TO 100 AAMA0799 + 6100 CALL DCYPHR(S,NI,0,DUM,NMAX) AAMA0800 + IF(NOPT.LT.1) CALL DCYPHR(S,NI,1,ALEXP,IDUM) $ GO TO 100 AAMA0801 + 6200 CALL DCYPHR(S,NI,0,DUM,L) $ CALL DCYPHR(S,NI,1,PL(L+1),IDUM) AAMA0802 + IF(L.LT.0.OR.L.GT.19.OR.PL(L+1).LT.0.000) WRITE(IW,6250) AAMA0803 + 6250 FORMAT(53H *** WARNING *** SPECIFICATIONS FOR INPUTED INITIAL L,AAMA0804 + 1 60H-DISTRIBUTION WRONG *** L OUT OF RANGE OR POPULATION NEGATIV,AAMA0805 + 2 8HE ******) AAMA0806 + GO TO 100 AAMA0807 + 6300 CALL DCYPHR(S,NI,0,DUM,NSTATE) $ CALL DCYPHR(S,NI,0,DUM,KAPPA) AAMA0808 + CALL DCYPHR(S,NI,1,EVACP,IDUM) $ CALL DCYPHR(S,NI,1,EBIND,IDUM) AAMA0809 + IF(NSTATE.GT.NMAX.OR.KAPPA.GT.2*NSTATE-1.OR.NSTATE.LE.0.OR.KAPPAAAMA0810 + 1 .LE.0) WRITE(IW,6325) AAMA0811 + 6325 FORMAT(53H *** ERROR *** DIRAC STATE INDECIES NEGATIVE, ZERO OR,AAMA0812 + 1 60H OUT OF LIMITS *** CHECK THE Q.NUMBERS OF THE STATES INPUTED)AAMA0813 + IF(EVACP.LT.0.000) EBIND = EBIND + EVACP $ IDR = IDR + 1 AAMA0814 + IF(EVACP.LT.0.000) WRITE(IW,6350)NSTATE,KAPPA AAMA0815 + 6350 FORMAT(46H *** VACUUM POLARIZATION LESS THAN ZERO FOR N=,I2, AAMA0816 + 1 12H, AND KAPPA=,I2,4H ***) AAMA0817 + 0 ENERGY(NSTATE,KAPPA) = EBIND + EVACP AAMA0818 + IF(ABS(EBIND).LE.1.0E-20) ENERGY(NSTATE,KAPPA) = EBIND + EVACP AAMA0819 + GO TO 100 AAMA0820 + 6400 CALL DCYPHR(S,NI,0,DUM,IPRINT) $ GO TO 100 AAMA0821 + 6500 DO 6550 K=1,20 $ CALL DCYPHR(S,NI,0,DUM,NPOL(K)) AAMA0822 + 6550 CONTINUE $ GO TO 100 AAMA0823 + 6600 CALL DCYPHR(S,NI,0,DUM,IPOL) $ GO TO 100 AAMA0824 + 6700 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0825 + CALL DCYPHR(S,NI,1,ZMK,IDUM) $ CALL DCYPHR(S,NI,1,ZML,IDUM) AAMA0826 + CALL DCYPHR(S,NI,1,ZMM,IDUM) $ GO TO 100 AAMA0827 + 6800 IF(IVRES.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0828 + CALL DCYPHR(S,NI,1,ZMKM,IDUM) $ CALL DCYPHR(S,NI,1,ZMLM,IDUM) AAMA0829 + CALL DCYPHR(S,NI,1,ZMMM,IDUM) $ GO TO 100 AAMA0830 + 6900 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0831 + DO 6950 K=1,K1 $ CALL DCYPHR(S,NI,0,DUM,IQ1(K)) AAMA0832 + 6950 CONTINUE $ GO TO 100 AAMA0833 + 6999 GO TO(7000,7100,7200,7300,7400,7500,7600,7700,7800,7900),JU AAMA0834 + 7000 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0835 + DO 7050 K=1,K2 $ CALL DCYPHR(S,NI,0,DUM,IQ2(K)) AAMA0836 + 7050 CONTINUE $ GO TO 100 AAMA0837 + 7100 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0838 + DO 7150 K=1,K3 $ CALL DCYPHR(S,NI,0,DUM,IQ3(K)) AAMA0839 + 7150 CONTINUE $ GO TO 100 AAMA0840 + 7200 CALL DCYPHR(S,NI,0,DUM,IDB) $ GO TO 100 AAMA0841 + 7300 DO 7350 K=1,4 $ CALL DCYPHR(S,NI,1,YC(K),IDUM) AAMA0842 + 7350 CONTINUE $ GO TO 100 AAMA0843 + 7400 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0844 + CALL DCYPHR(S,NI,0,DUM,IYC) $ GO TO 100 AAMA0845 + 7500 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0846 + DO 7550 K=1,4 $ CALL DCYPHR(S,NI,0,DUM,IJ(K)) AAMA0847 + 7550 CONTINUE $ GO TO 100 AAMA0848 + 7600 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0849 + DO 7650 K=1,4 $ CALL DCYPHR(S,NI,1,YJ(K),DUM) AAMA0850 + 7650 CONTINUE $ GO TO 100 AAMA0851 + 7700 IF(IVERS.NE.1) WRITE(IW,900) $ IF(IVERS.NE.1) GO TO 100 AAMA0852 + DO 7750 K=1,4 $ CALL DCYPHR(S,NI,0,DUM,JJ1(K)) AAMA0853 + 7750 CONTINUE $ GO TO 100 AAMA0854 + 7800 DO 7850 K=1,3 $ CALL DCYPHR(S,NI,0,DUM,IPC(K)) AAMA0855 + 7850 CONTINUE $ GO TO 100 AAMA0856 + 7900 CALL DCYPHR(S,NI,1,CL1,IDUM) $ CALL DCYPHR(S,NI,1,CL2,IDUM) AAMA0857 + GO TO 100 AAMA0858 + 7999 GO TO(8000,8100,8200,8300,8400,8500,8600,8700,8800,8900),JU AAMA0859 + 8000 CALL DCYPHR(S,NI,1,ESP,IDUM) $ GO TO 100 AAMA0860 + 8100 MPU = MPU + 1 $ CALL DCYPHR(S,NI,0,DUM,N1J) AAMA0861 + CALL DCYPHR(S,NI,0,DUM,L1J) $ CALL DCYPHR(S,NI,0,DUM,J1J) AAMA0862 + CALL DCYPHR(S,NI,0,DUM,N2J) $ CALL DCYPHR(S,NI,0,DUM,L2J) AAMA0863 + CALL DCYPHR(S,NI,0,DUM,J2J) $ CALL DCYPHR(S,NI,0,DUM,IRS) AAMA0864 + IF(N1J.GT.20.OR.N1J.LE.1.OR.N2J.GT.N1J.OR.N2J.LE.0.OR.L1J.GE.N1JAAMA0865 + 1 .OR.L1J.LT.0.OR.L2J.GE.N2J.OR.L2J.LT.0.OR.J1J*J1J.NE.J1J.OR.J2J AAMA0866 + 2 *J2J.NE.J2J.OR.IABS(L1J-L2J).GT.3.OR.IRS.GT.2.OR.IRS.LT. AAMA0867 + 3 0.OR.(N2J.EQ.N1J.AND.N2J.NE.2)) WRITE(IW,8150) AAMA0868 + 8150 FORMAT(53H *** WARNING *** SPECIFICATIONS FOR TRANSITION TO BE ,AAMA0869 + 1 60HPUNCHED ARE WRONG *** NO SUCH LINE OR GROUP EXISTS *** NO PU,AAMA0870 + 2 8HNCH ****) AAMA0871 + ICPU(MPU) = N1J + 32*L1J + 1024*J1J + 2048*N2J + 65536*L2J + AAMA0872 + 1 2097152*J2J + 4194304*IRS $ GO TO 100 AAMA0873 + 8200 CALL DCYPHR(S,NI,0,DUM,IDE) $ GO TO 100 AAMA0874 + 8300 CALL DCYPHR(S,NI,0,DUM,IPN) $ GO TO 100 AAMA0875 + 8400 DO 8450 K=1,6 $ CALL DCYPHR(S,NI,0,DUM,JTM(K)) AAMA0876 + 8450 CONTINUE $ GO TO 100 AAMA0877 + 8500 DO 8550 K=1,6 $ CALL DCYPHR(S,NI,0,DUM,JTD(K)) AAMA0878 + 8550 CONTINUE $ GO TO 100 AAMA0879 + 8600 DO 8650 K=1,6 $ CALL DCYPHR(S,NI,0,DUM,JTQ(K)) AAMA0880 + 8650 CONTINUE $ GO TO 100 AAMA0881 + 8700 DO 8750 K=1,6 $ CALL DCYPHR(S,NI,0,DUM,JTO(K)) AAMA0882 + 8750 CONTINUE $ GO TO 100 AAMA0883 + 8800 CALL DCYPHR(S,NI,0,DUM,N8) $ CALL DCYPHR(S,NI,0,DUM,LD8) AAMA0884 + CALL DCYPHR(S,NI,0,DUM,LU8) $ CALL DCYPHR(S,NI,1,A8,IDUM) AAMA0885 + L8 = LU8 - LD8 + 1 $ S8 = 0.000 AAMA0886 + DO 8850 K=1,L8 $ CALL DCYPHR(S,NI,1,B8,IDUM) AAMA0887 + IF(N8.LT.1.OR.LD8.LT.0.OR.LU8.LT.LD8.OR.N8.GT.20.OR.LU8.GE.N8.ORAAMA0888 + 1 .A8.LT.0.000.OR.B8.LT.0.000) WRITE(IW,8880) AAMA0889 + 8880 FORMAT(53H *** WARNING *** SPEC.S FOR THE INITIAL L-DISTRIBUTIO,AAMA0890 + 1 60HN GIVEN ARE WRONG *** INTEGERS OUT OF LIMITS OR REALS NEGATI,AAMA0891 + 2 8HVE *****) AAMA0892 + K8 = N8*(N8-1)/2 + LD8 + K $ PLN(K8) = B8 $ S8 = S8 + B8 AAMA0893 + 8850 CONTINUE $ DO 8875 K=1,L8 $ K8 = N8*(N8-1)/2 + LD8 + K AAMA0894 + IF(A8.LE.0.000) A8 = S8 $ PLN(K8) = PLN(K8)*A8/AMAX1(S8,1.E-20)AAMA0895 + 8875 CONTINUE $ GO TO 100 AAMA0896 + 8900 CALL DCYPHR(S,NI,0,DUM,IP8) $ GO TO 100 AAMA0897 + 8999 GO TO( 100, 100, 100, 100, 100, 100, 100, 100, 100, 100),JU AAMA0898 +C *** THIS SECTION IS DEVOTED TO THE DISCOVERY AND RECOVERY OF ERRORS.AAMA0899 +C *** ALL POSSIBLE INPUT DATA ARE SCREENED FOR ERRORS (WITHIN REASON) AAMA0900 +C *** THIS PORTION MAY BE REMOVED IF YOU ARE CONFIDENT THAT YOU MAKE AAMA0901 +C *** NO MISTAKES IN THE INPUT SPECIFICATIONS...................... AAMA0902 +10000 IF(Z.LE.0.00) WRITE(IW,10100) $ IF(Z.GT.99.00) WRITE(IW,10200)AAMA0903 + IF(Z.GT.137.04) WRITE(IW,10300) $ IF(AMOD(Z+0.001,1.000).GT. AAMA0904 + 1 0.002) WRITE(IW,10400) $ IF(Z.LE.0.000) STOP AAMA0905 +10100 FORMAT(53H *** ERROR *** ATOMIC NUMBER Z ZERO OR NEGATIVE *** E,AAMA0906 + 1 60HXECUTION TERMINATED *** ....................................)AAMA0907 +10200 FORMAT(53H *** WARNING *** ATOMIC NUMBER Z TOO BIG *** LAST TWO,AAMA0908 + 1 60HDIGITS WILL BE PRINTED IN BLOCK LETTERS IN THE UPPER LEFT OF,AAMA0909 + 2 8HTABLE **) AAMA0910 +10300 FORMAT(53H *** WARNING *** ATOMIC NUMBER Z TOO BIG *** POINT LI,AAMA0911 + 1 60HKE DIRAC FORMULAE HAVE PROBLEMS *** NO ATTEMPT TO RECTIFY PR,AAMA0912 + 2 8HOBLEM **) AAMA0913 +10400 FORMAT(53H *** WARNING *** ATOMIC NUMBER Z NOT CLOSE TO AN INTE,AAMA0914 + 1 60HGER VALUE *** INTEGER PART PRINTED IN TABLE,BUT ACTUAL VALUE,AAMA0915 + 2 8H USED **) AAMA0916 + DO 10500 K=1,3 $ IF(BE(K).LT.0.000) WRITE(IW,10600) AAMA0917 +10500 CONTINUE $ IF(BE(1).LT.4.0*BE(2).OR.BE(2).LT.2.0*BE(3)) WRITE( AAMA0918 + 1 IW,10700) $ IF(BE(1).GT.15.0*Z*Z.OR.BE(1).LT.5.00*Z*Z) WRITE( AAMA0919 + 2 IW,10800) $ IF(BE(3).GT.1000.0) WRITE(IW,10900) AAMA0920 +10600 FORMAT(53H *** ERROR *** BINDING ENERGY(IES) NEGATIVE OR ZERO *,AAMA0921 + 1 60H** PROGRAM WILL HALT LATER *** NO ATTEMPT TO CORRECT PROBLEM,AAMA0922 + 2 8H *******) AAMA0923 +10700 FORMAT(53H *** WARNING *** BINDING ENERGIES NOT IN ANY REASONAB,AAMA0924 + 1 60HLE PROPORTION *** POSSIBLY ENETRED OUT OF SEQUENCE (MUST BE ,AAMA0925 + 2 8HK,L,M **) AAMA0926 +10800 FORMAT(53H *** WARNING *** BINDING ENERGIES NOT IN ANY REASONAB,AAMA0927 + 1 60HLE RANGE *** POSSIBLY IN THE WRONG UNITS (MUST BE IN EV) OR ,AAMA0928 + 2 8HZ ******) AAMA0929 +10900 FORMAT(53H *** WARNING *** BINDING ENERGY OF M SHELL UNREASONAB,AAMA0930 + 1 60HLY HIGH *** CHECK YOUR SOURCE OR DISREGARD IF INTENTIONALLY ,AAMA0931 + 2 8HSET ****) AAMA0932 + IF(K0.GT.3.OR.K1.GT.7.OR.K2.GT.7.OR.K3.GT.7) WRITE(IW,11000) AAMA0933 +11000 FORMAT(53H *** ERROR *** TOO MANY CASES SPECIFIED FOR THE MULTI,AAMA0934 + 1 60HPOLARITIES *** MAX ARE M/3 D,Q,O/7 *** RESULTS WILL BE INCOR,AAMA0935 + 2 8HRECT ***) AAMA0936 + IF(K0.LT.0.OR.K1.LT.0.OR.K2.LT.0.OR.K3.LT.0) WRITE(IW,11100) AAMA0937 +11100 FORMAT(53H *** ERROR *** NEGATIVE NUMBER OF CASES SPECIFIED FOR,AAMA0938 + 1 60H THE MULTIPOLARITIES *** MUST BE POSITIVE OR ZERO TO SKIP AN,AAMA0939 + 2 8HYONE ***) AAMA0940 + IF((K0.EQ.2.AND.NN0(1).EQ.NN0(2)).OR.(K0.EQ.3.AND.(NN0(1).EQ.NN0AAMA0941 + 1 (2).OR.NN0(1).EQ.NN0(3).OR.NN0(2).EQ.NN0(3)))) WRITE(IW,11200) AAMA0942 +11200 FORMAT(53H *** ERROR *** DUPLICATE SHELL SPECIFICATION IN MONOP,AAMA0943 + 1 60HOLE RATE CALCULATION *** WILL NOT ABORT BUT RESULTS WILL BE ,AAMA0944 + 2 8HWRONG **) AAMA0945 + IF((K0.EQ.1.AND.NN0(1).EQ.0).OR.(K0.EQ.1.AND.NN0(1)*NN0(2).EQ.0)AAMA0946 + 1 .OR.(K0.EQ.3.AND.NN0(1)*NN0(2)*NN0(3).EQ.0)) WRITE(IW,11300) AAMA0947 +11300 FORMAT(53H *** ERROR *** RADIATION SPECIFIED FOR MONOPOLE CASES,AAMA0948 + 1 60H *** NO SUCH RATE EXISTS, SO THE PROGRAM MIGHT DO STRANGE TH,AAMA0949 + 2 8HINGS ***) AAMA0950 + IF(K1.LE.1) GO TO 12000 $ DO 11500 K=2,K1 $ IF(NN1(K).LE.0) AAMA0951 + 1 WRITE(IW,11600) $ IF(M1(K).LT.0) WRITE(IW,11700) AAMA0952 + IF(NN1(K).GT.3) WRITE(IW,11900) AAMA0953 + IF(M1(K).GE.NN1(K).AND.NN1(K).NE.1) WRITE(IW,11900) AAMA0954 + IF(K.EQ.2) GO TO 11500 $ K4 = K-1 $ DO 11400 I=2,K4 AAMA0955 + IF(NN1(I).EQ.NN1(K).AND.M1(K).EQ.M1(I)) WRITE(IW,11800) AAMA0956 + IF(NN1(I).EQ.NN1(K).AND.M1(I)*M1(K).EQ.0) WRITE(IW,11800) AAMA0957 +11400 CONTINUE AAMA0958 +11500 CONTINUE AAMA0959 +11600 FORMAT(53H *** ERROR *** NEGATIVE SHELL Q. N. SPECIFIED OR DUPL,AAMA0960 + 1 60HICATE RADIATION CALCULATION *** NO ATTEMPT TO FIX *** CHECK ,AAMA0961 + 2 8HNNJ ****) AAMA0962 +11700 FORMAT(53H *** ERROR *** NEGATIVE SUBSHELL CODE SPECIFICATION *,AAMA0963 + 1 60H** PROGRAM WILL TAKE AN UNPREDICTABLE BRANCH OR ABORT *** CH,AAMA0964 + 2 8HECK MJ *) AAMA0965 +11800 FORMAT(53H *** ERROR *** DUPLICATE OR OVERLAPPING SUBSHELL CODE,AAMA0966 + 1 60H SPECIFIED *** WILL NOT ABORT, BUT RATES WILL BE DONE TWICE ,AAMA0967 + 2 8H********) AAMA0968 +11900 FORMAT(53H *** ERROR *** NON EXISTENT SHELL (.GT.3) OR SUBSHELL,AAMA0969 + 1 60H COMBINATION (E.G. 2D) *** OUTCOME UNPREDICTABLE *** CHECK N,AAMA0970 + 2 8HNJ,MJ **) AAMA0971 +12000 IF(K2.LE.1) GO TO 12300 $ DO 12200 K=2,K2 $ IF(NN2(K).LE.0) AAMA0972 + 1 WRITE(IW,11600) $ IF(M2(K).LT.0) WRITE(IW,11700) AAMA0973 + IF(NN2(K).GT.3) WRITE(IW,11900) AAMA0974 + IF(M2(K).GE.NN2(K).AND.NN2(K).NE.1) WRITE(IW,11900) AAMA0975 + IF(K.EQ.2) GO TO 12200 $ K4 = K-1 $ DO 12100 I=2,K4 AAMA0976 + IF(NN2(I).EQ.NN2(K).AND.M2(K).EQ.M2(I)) WRITE(IW,11800) AAMA0977 + IF(NN2(I).EQ.NN2(K).AND.M2(I)*M2(K).EQ.0) WRITE(IW,11800) AAMA0978 +12100 CONTINUE AAMA0979 +12200 CONTINUE AAMA0980 +12300 IF(K3.LE.1) GO TO 12600 $ DO 12500 K=2,K3 $ IF(NN3(K).LE.0) AAMA0981 + 1 WRITE(IW,11600) $ IF(M3(K).LT.0) WRITE(IW,11700) AAMA0982 + IF(NN3(K).GT.3) WRITE(IW,11900) AAMA0983 + IF(M3(K).GE.NN3(K).AND.NN3(K).NE.1) WRITE(IW,11900) AAMA0984 + IF(K.EQ.2) GO TO 12500 $ K4=K-1 $ DO 12400 I=2,K4 AAMA0985 + IF(NN3(I).EQ.NN3(K).AND.M3(K).EQ.M3(I)) WRITE(IW,11800) AAMA0986 + IF(NN3(I).EQ.NN3(K).AND.M3(I)*M3(K).EQ.0) WRITE(IW,11800) AAMA0987 +12400 CONTINUE AAMA0988 +12500 CONTINUE AAMA0989 +12600 IF(K1.LE.1) GO TO 12900 $ DO 12700 K=2,K1 AAMA0990 + IF(IP1(K)*IP1(K).NE.IP1(K)) WRITE(IW,12800) AAMA0991 +12700 CONTINUE AAMA0992 +12800 FORMAT(53H *** WARNING *** PENETRATION CODES FOR SUBSHELLS NOT ,AAMA0993 + 1 60HZERO OR ONE *** POSSIBLE ERRONEOUS RESULT *** CHECK ARRAYS I,AAMA0994 + 2 8HPJ(K) **) AAMA0995 +12900 IF(K2.LE.1) GO TO 13100 $ DO 13000 K=2,K2 AAMA0996 + IF(IP2(K)*IP2(K).NE.IP2(K)) WRITE(IW,12800) AAMA0997 +13000 CONTINUE AAMA0998 +13100 IF(K3.LE.1) GO TO 13300 $ DO 13200 K=2,K3 AAMA0999 + IF(IP3(K)*IP3(K).NE.IP3(K)) WRITE(IW,12800) AAMA1000 +13200 CONTINUE AAMA1001 +13300 DO 13400 I=1,6 $ IF(JTM(I).GT.3.OR.JTM(I).LT.1.OR.JTD(I).LT.1 AAMA1002 + 1 .OR.JTD(I).GT.3.OR.JTQ(I).LT.1.OR.JTQ(I).GT.3.OR.JTO(I).GT.3.OR.AAMA1003 + 2 JTO(I).LT.1) WRITE(IW,13500) AAMA1004 +13400 CONTINUE AAMA1005 +13500 FORMAT(53H *** WARNING *** NUMBER OF TERMS IN PENETRATION CALCU,AAMA1006 + 1 60HLATION OUTSIDE RANGE (1-3) *** DISREGARD IF PENETRATION NOT ,AAMA1007 + 2 8HUSED ***) AAMA1008 + IF(IC.LT.0.OR.IC.GT.3) WRITE(IW,13600) AAMA1009 +13600 FORMAT(53H *** ERROR *** ACCURACY CONTROL OPTION CODE OUTSIDE P,AAMA1010 + 1 60HERMISSIBLE RANGE (0-3) *** UNPREDICTABLE RESULTS CAN HAPPEN ,AAMA1011 + 2 8H********) AAMA1012 + IF(IR.LE.0.OR.IW.LE.0.OR.IPUNCH.LE.0) WRITE(IW,13700) AAMA1013 +13700 FORMAT(53H *** WARNING *** I/O UNIT NUMBER NEGATIVE OR ZERO ***,AAMA1014 + 1 60H UNLIKELY TO BE READ OR WRITE UNIT *** IF PUNCH...WHO KNOWS ,AAMA1015 + 2 8HRESULT *) AAMA1016 + IF(IR.GT.99.OR.IW.GT.99.OR.IPUNCH.GT.99) WRITE(IW,13800) AAMA1017 +13800 FORMAT(53H *** WARNING *** I/O UNIT NUMBER EXCEEDING 99 *** NON,AAMA1018 + 1 60H STANDARD FORTRAN ASSIGNMENT *** DISREGARD IF INTENTIONALLY ,AAMA1019 + 2 8HSET ****) AAMA1020 + IF(IPR.LT.0) WRITE(IW,13900) $ IF(IPR.GT.63) WRITE(IW,14000) AAMA1021 +13900 FORMAT(53H *** ERROR *** PRINT SELECTION OPTION CODE NEGATIVE *,AAMA1022 + 1 60H** MODULO ROUTINE WILL FIGURE OPTIONS ERRONEOUSLY *** CHECK ,AAMA1023 + 2 8HIPR ****) AAMA1024 +14000 FORMAT(53H *** WARNING *** PRINT SELECTION OPTION CODE .GT. 63 ,AAMA1025 + 1 60H*** LAST 6 BITS OF NUMBER WILL BE USED IN PRINT (MOD(IPR,64),AAMA1026 + 2 8H) ******) AAMA1027 + IF(FD.GT.99.99.OR.FD.LT.0.01) WRITE(IW,14100) AAMA1028 +14100 FORMAT(53H *** WARNING *** FACTORIAL DIVIDER NOT IN ANY REASONA,AAMA1029 + 1 60HBLE RANGE (0.01-99.99) *** COULD CAUSE SEVERE ARITHMETIC PRO,AAMA1030 + 2 8HBLEMS **) AAMA1031 + IF(IDB*IDB.NE.IDB) WRITE(IW,14200) AAMA1032 +14200 FORMAT(53H *** WARNING *** DEBUG OPTION SELECTION SWITCH NOT ZE,AAMA1033 + 1 60HRO OR ONE *** COULD CAUSE ERRORS IN THE PRINTING OF DETAILED,AAMA1034 + 2 8H RATES *) AAMA1035 + IF(IPN*IPN.NE.IPN) WRITE(IW,14300) AAMA1036 +14300 FORMAT(53H *** WARNING *** PUNCH SELECTION SWITCH NOT ZERO OR O,AAMA1037 + 1 60HNE *** COULD RESULT IN UNINTENTIONAL INCLUSION OR OMISSION O,AAMA1038 + 2 8HF PUNCH*) AAMA1039 + IF(IDE.LT.0.OR.IDE.GT.99999) WRITE(IW,14400) AAMA1040 +14400 FORMAT(53H *** WARNING *** PUNCH CARD IDENTIFICATION NUMBER NEG,AAMA1041 + 1 60HATIVE OT .GT. 99999 *** WILL PUNCH 5 STARS INSTEAD, IF .GT. ,AAMA1042 + 2 8H5 DIGITS) AAMA1043 + IF(WIDTHK.LT.0.0.OR.WIDTHK.GT.999.999) WRITE(IW,14500) AAMA1044 +14500 FORMAT(53H *** WARNING *** REFILLING WIDTH OF K-ELECTRON SHELL ,AAMA1045 + 1 60HNEGATIVE OR UNREASONABLY LARGE *** CHECK FOR PROPER UNITS (E,AAMA1046 + 2 8HV) *****) AAMA1047 + IF(D2P1S.LT.Z*Z*AMASSM.OR.D2P1S.GT.10.2*Z*Z*AMASSM) AAMA1048 + 1 WRITE(IW,14600) AAMA1049 +14600 FORMAT(53H *** WARNING *** ENERGY OF THE 2P-1S MUONIC TRANSITIO,AAMA1050 + 1 60HN NEGATIVE, TOO LOW OR UNREASONABLY HIGH *** CHECK FOR UNITS,AAMA1051 + 2 8H (EV) **) AAMA1052 + IF(ESP.LT.0.000.OR.ESP.GT.1.0E7) WRITE(IW,14700) AAMA1053 +14700 FORMAT(53H *** WARNING *** ENERGY OF THE 2S-2P MUONIC TRANSITIO,AAMA1054 + 1 60HN NEGATIVE OR TOO LARGE *** SET TO ZERO IF TRANSITION TO BE ,AAMA1055 + 2 8HSKIPPED*) AAMA1056 + IF(NOPT.LT.-1.OR.NOPT.GT.2) WRITE(IW,14800) AAMA1057 +14800 FORMAT(53H *** WARNING *** INITIAL L-DISTRIBUTION OPTION CODE U,AAMA1058 + 1 60HNRECOGNIZABLE *** COULD CAUSE UNEXPECTED COMPLICATIONS IF OF,AAMA1059 + 2 8H LIMITS*) AAMA1060 + IF(NMAX.LT.2.OR.NMAX.GT.20) WRITE(IW,14900) AAMA1061 +14900 FORMAT(53H *** ERROR *** STARTING N QUANTUM NUMBER OF THE CASCA,AAMA1062 + 1 60HDE NOT IN THE RANGE 2-20 *** PROGRAM WILL ABORT IF .GT. 20 O,AAMA1063 + 2 8HR .LT. 1) AAMA1064 + IF(NOPT.EQ.0.AND.ABS(ALEXP).GT.1.000) WRITE(IW,15000) AAMA1065 +15000 FORMAT(53H *** WARNING *** MODIFIED STATISTICAL L-DISTRIBUTION ,AAMA1066 + 1 60HEXPONENT TOO HIGH OR TOO LOW (NEG) *** COULD CAUSE ARITH. OV,AAMA1067 + 2 8HERFLOW *) AAMA1068 + IF(IP8*IP8.NE.IP8) WRITE(IW,15100) AAMA1069 +15100 FORMAT(53H *** WARNING *** L-DISTRIBUTION TABLE SELECTION CODE ,AAMA1070 + 1 60H(TOP N ONLY OR FULL N-L) NOT ZERO OR ONE *** COULD RESULT IN,AAMA1071 + 2 8H ERRORS*) AAMA1072 + IF(ABS(CL1).GT.10.0.OR.ABS(CL2).GT.10.0) WRITE(IW,15200) AAMA1073 +15200 FORMAT(53H *** WARNING *** INITIAL QUADRATIC L-DISTRIBUTION PAR,AAMA1074 + 1 60HAMETERS UNREASONABLY HIGH OR LOW (ABS .GT. 10.0) *** POSSIBL,AAMA1075 + 2 8HE ERRORS) AAMA1076 + IF(IPC(1)*IPC(1).NE.IPC(1).OR.IPC(2)*IPC(2).NE.IPC(2).OR.IPC(3)*AAMA1077 + 1 IPC(3).NE.IPC(3)) WRITE(IW,15300) AAMA1078 +15300 FORMAT(53H *** WARNING *** ELECTRON REFILLING CONTROL CODES NOT,AAMA1079 + 1 60H EQUAL TO ZERO OR ONE *** REFILLING MIGHT NOT BE DONE PROPER,AAMA1080 + 2 8HLY *****) AAMA1081 + DO 15400 I=1,NMAX $ IF(NPOL(I).LT.-1.OR.NPOL(I).GT.NMAX-1) AAMA1082 + 1 WRITE(IW,15500) AAMA1083 +15400 CONTINUE $ IF(IPOL*IPOL.NE.IPOL) WRITE(IW,15600) AAMA1084 +15500 FORMAT(53H *** WARNING *** POLARIZATION CODE N.S FOR EACH L OUT,AAMA1085 + 1 60H OF RANGE *** POLARIZATION MIGHT BE WRONG OR PROGRAM WILL AB,AAMA1086 + 2 8HORT ****) AAMA1087 +15600 FORMAT(53H *** WARNING *** POLARIZATION CALCULATION SELECTION S,AAMA1088 + 1 60HWITCH NOT EQUAL TO ZERO OR ONE *** POSSIBLE UNDESIRED RESULT,AAMA1089 + 2 8HS ******) AAMA1090 + IF(YC(1).LT.0.0.OR.YC(1).GT.20.0.OR.YC(2).LT.0.0.OR.YC(2).GT.20.AAMA1091 + 1 0.OR.YC(3).GT.20.0.OR.YC(3).LT.0.0.OR.YC(4).LT.0.0.OR.YC(4).GT. AAMA1092 + 2 20.) WRITE(IW,15700) AAMA1093 +15700 FORMAT(53H *** WARNING *** CUTOFF Y.S FOR THE MULTIPOLARITIES N,AAMA1094 + 1 60HEGATIVE OR UNREASONABLY HIGH *** IF HIGH CHECK IF SO DESIRED,AAMA1095 + 2 8H *******) AAMA1096 + IF(ABS(AMASSM-206.7686).GT.1.0E-10) WRITE(IW,15800) AAMA1097 +15800 FORMAT(53H *** WARNING *** NONSTANDARD MASS OF PARTICLE (NOT MU,AAMA1098 + 1 60HON) *** CHECK IF THIS IS INTENTIONAL AND THE MASS IS IN ELEC,AAMA1099 + 2 8HT. M.S *) AAMA1100 + IF(ABS(AMASSE-511003.4).GT.1.0E-03) WRITE(IW,15900) AAMA1101 +15900 FORMAT(53H *** WARNING *** NONSTANDARD MASS FOR THE ELECTRON **,AAMA1102 + 1 60H* CHECK IF THIS IS INTENTIONAL AND THAT THE MASS IN IN ELECT,AAMA1103 + 2 8H. VOLTS*) AAMA1104 + IF(ABS(AMASSN-931.48).GT.1.0E-10) WRITE(IW,16000) AAMA1105 +16000 FORMAT(53H *** WARNING NONSTANDARD MASS FOR THE AVERAGE NUCLEON,AAMA1106 + 1 60H BOUND MASS *** CHECK IF THIS IS INTENTIONAL AND THE MASS IN,AAMA1107 + 2 8H MEV ***) AAMA1108 + IF(ABS(AA-140.0).GT.1.0E-10.AND.(AA.LT.1.3*Z.OR.AA.GT.2.7*Z)) AAMA1109 + 1 WRITE(IW,16100) AAMA1110 +16100 FORMAT(53H *** WARNING *** ATOMIC WEIGHT A NOT CHANGED FROM DEF,AAMA1111 + 1 60HAULT OR UNREASONABLY HIGH OR LOW *** REDUCED MASS CALCULATIO,AAMA1112 + 2 8HN OFF **) AAMA1113 + IF(CFM.LT.0.0.OR.CFM.GT.7.5.OR.TFM.LT.0.5.OR.TFM.GT.3.0) AAMA1114 + 1 WRITE(IW,16200) AAMA1115 +16200 FORMAT(53H *** WARNING *** FERMI DISTRIBUTION PARAMETERS UNREAS,AAMA1116 + 1 60HONABLY HIGH OR LOW *** NOT USED IN ANY CALCULATION IN THIS P,AAMA1117 + 2 8HROGRAM *) AAMA1118 + IF(STEP.LT.0..OR.RMATCH.LT.0..OR.RMATCH.GT.1.E4) WRITE(IW,16300)AAMA1119 +16300 FORMAT(53H *** WARNING *** STEP IN INTEGRATION NEGATIVE OR MATC,AAMA1120 + 1 60HHING RADIUS NEGATIVE OR UNREASONABLY LARGE *** NOT USED IN P,AAMA1121 + 2 8HROGRAM *) AAMA1122 + IF(EHIGH.GT.30.0.OR.EHIGH.LT.0.001) WRITE(IW,16400) AAMA1123 +16400 FORMAT(53H *** WARNING *** HIGH CUT OF ENERGY IN X-RAY CATALOGU,AAMA1124 + 1 60HE TOO HIGH OR TOO LOW *** CHECK UNITS (MEV) *** OK IF INTENT,AAMA1125 + 2 8HIONAL **) AAMA1126 + IF(ELOW.GT.EHIGH.OR.ELOW.LT.0.001) WRITE(IW,16500) AAMA1127 +16500 FORMAT(53H *** WARNING *** LOW CUT OF ENERGY IN X-RAY CATALOGUE,AAMA1128 + 1 60H MORE THAN THE HIGH CUT OR TOO LOW *** CHECK UNITS (MEV) AND,AAMA1129 + 2 8H EHI ***) AAMA1130 + IF(CLIMIT.GT.0.5.OR.CLIMIT.LT.1.0E-7) WRITE(IW,16600) AAMA1131 +16600 FORMAT(53H *** WARNING *** INTENSITY LIMIT CUTOFF FOR THE X-RAY,AAMA1132 + 1 60H CATALOGUE TOO HIGH OR TOO LOW *** TOO FOW OR TOO MANY LINES,AAMA1133 + 2 8HWRITTEN*) AAMA1134 + IF(ERES.LT.1.0E-6.OR.ERES.GT.0.05) WRITE(IW,16700) AAMA1135 +16700 FORMAT(53H *** WARNING *** ENERGY RESOLUTION IN THE X-RAY CATAL,AAMA1136 + 1 60HOGUE TOO HIGH OR TOO LOW *** POSSIBLY WRONG UNITS (MUST BE I,AAMA1137 + 2 8HN MEV **) AAMA1138 + IF(ICC*ICC.NE.ICC) WRITE(IW,16800) AAMA1139 +16800 FORMAT(53H *** WARNING *** INPUTED DIVIDING POINTS SWITCH IS NO,AAMA1140 + 1 60HT ZERO OR ONE *** POSSIBLE UNWANTED DIVIDING POINTS IN CATAL,AAMA1141 + 2 8HOGUE ***) AAMA1142 + IF(CD(1).GT.0.5.OR.CD(2).LE.CD(3).OR.CD(3).LE.CD(4).OR.CD(4).LT.AAMA1143 + 1 CD(5).OR.CD(5).LT.1.2*CLIMIT) WRITE(IW,16900) AAMA1144 +16900 FORMAT(53H *** WARNING *** NEW STAR DIVIDING POINTS FOR THE X-R,AAMA1145 + 1 60HAY CATALOGUE TOO HIGH, TOO LOW OR UNREASONABLY CLOSE SPACED ,AAMA1146 + 2 8H********) AAMA1147 + IF(EB.LE.0.000) WRITE(IW,17000) AAMA1148 +17000 FORMAT(53H *** WARNING *** CALIBRATION PARAMETER B FOR THE CONV,AAMA1149 + 1 60HERSION OF ENERGY TO CHANNEL NUMBER NEGATIVE OR 0 *** IF 0 PR,AAMA1150 + 2 8HOG. HALT) AAMA1151 + IF(MPU.GT.200) WRITE(IW,17100) AAMA1152 +17100 FORMAT(53H *** ERROR *** TOO MANY LINES SPECIFIED TO BE PUNCHED,AAMA1153 + 1 60H *** IF YOU WANT MORE THAN 200 LINES INCREASE THE DIM OF ICP,AAMA1154 + 2 8HU IN L41) AAMA1155 + IF(IPC(1)*IPC(2)*IPC(3).EQ.0.AND.IP8.EQ.1) WRITE(IW,17200) AAMA1156 + IF(IPC(1)*IPC(2)*IPC(3).EQ.0.AND.IP8.EQ.1) STOP AAMA1157 +17200 FORMAT(53H *** ERROR *** FULL (N,L) L-DISTRIBUTION REQUIRES REF,AAMA1158 + 1 60HILLING OF ALL SHELLS (IPC 1 1 1) *** EXECUTION TERMINATED **,AAMA1159 + 2 8H********) AAMA1160 + IF(IPOL.EQ.0.AND.IP8.EQ.1) WRITE(IW,17300) AAMA1161 +17300 FORMAT(53H *** WARNING *** FULL N-L DISTRIBUTION SPECIFIED AND ,AAMA1162 + 1 60HDEPOLARIZATION CALCULATION *** DEPOLARIZATION MAY BE WRONG *,AAMA1163 + 2 8H********) AAMA1164 + IF(EA.GT.2.0E4.OR.EA.LT.-2.0E4) WRITE(IW,17400) AAMA1165 +17400 FORMAT(53H *** WARNING *** CALIBRATION ENERGY POINT EA UNREASON,AAMA1166 + 1 60HABLY HIGH OR LOW *** CHECK FOR UNITS (MUST BE IN KEV) ******,AAMA1167 + 2 8H********) AAMA1168 + IF(Z.LT.30.0.AND.(Z-20.0)*0.1.GT.POP(6)) WRITE(IW,17500) AAMA1169 + IF(Z.LT.18.0.AND.(Z-12.0)/6.0.GT.POP(5)) WRITE(IW,17500) AAMA1170 + IF(Z.LT.12.0.AND.(Z-10.0)*0.5.GT.POP(4)) WRITE(IW,17500) AAMA1171 + IF(Z.LT.10.0.AND.(Z-4.0)/6.0.GT.POP(3)) WRITE(IW,17500) AAMA1172 + IF(Z.LT.4.0.AND.(Z-2.0)*0.5.GT.POP(2)) WRITE(IW,17500) AAMA1173 + IF((Z.LE.20.0.AND.POP(6).NE.0.0).OR.(Z.LE.12.0.AND.POP(5).NE.0.0AAMA1174 + 1 ).OR.(Z.LE.10.0.AND.POP(4).NE.0.0).OR.(Z.LE.4.0.AND.POP(3).NE.0.AAMA1175 + 2 ).OR.(Z.LE.2.0.AND.POP(2).NE.0.0)) WRITE(IW,17500) AAMA1176 +17500 FORMAT(53H *** ERROR *** Z IS TOO LOW TO SUPPORT SPECIFIED POPU,AAMA1177 + 1 60HLATION OF ELECTRONIC SHELLS *** POSSIBLE ERRONEOUS RESULTS *,AAMA1178 + 1 8H********) AAMA1179 + END AAMA1180 +C-----------------------------------------------------------------------AAMA1181 + 0 SUBROUTINE DCYPHR(A,NJ,ITYPE,R,I) AAMA1182 +C *** DECYPHERS THE NUMBERS FOR ROUTINE RREAD. FINDS INPUT ERRORS AAMA1183 + INTEGER A,BB,AA,BL,SE,CO,PL,DA,PO,EE AAMA1184 + DIMENSION A(70),BB(10),AA(20) AAMA1185 + COMMON/LOC008/IREAD,IW,IPUNCH,IPRINT AAMA1186 + DATA BB/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/ AAMA1187 + DATA BL,SE,CO,PL,DA,PO,EE/1H ,1H/,1H,,1H+,1H-,1H.,1HE/ $ IG = 0 AAMA1188 + DO 100 J=NJ,70 $ NI1 = J+1 AAMA1189 + IF((A(J).EQ.BL.OR.A(J).EQ.SE.OR.A(J).EQ.CO).AND.IG.EQ.0) AAMA1190 + 1 GO TO 100 AAMA1191 + IF((A(J).EQ.BL.OR.A(J).EQ.SE.OR.A(J).EQ.CO).AND.IG.NE.0) AAMA1192 + 1 GO TO 200 $ IG = IG+1 $ AA(IG) = A(J) AAMA1193 + 100 CONTINUE AAMA1194 + 200 NJ = NI1 $ IF(ITYPE.EQ.1) GO TO 1000 $ DO 600 J=1,IG $ IFL = 0 AAMA1195 + IF(J.NE.1) GO TO 300 $ IF(AA(J).EQ.PL.OR.AA(J).EQ.DA) IFL=1 AAMA1196 + 300 DO 400 K=1,10 $ IF(AA(J).EQ.BB(K)) IFL=1 AAMA1197 + 400 CONTINUE $ IF(IFL.EQ.0) WRITE(IW,500)AA(J) AAMA1198 + 500 FORMAT(/38H *** ERROR *** ILLEGAL DATA IN INPUT /,A1,5H/ ***/ AAMA1199 + 1 60H *** STANDARD FIXUP TAKEN (TAKEN AS 0), EXECUTION CONTINUING)AAMA1200 + 0 IF(IFL.EQ.0) AA(J)=BB(1) AAMA1201 + 600 CONTINUE $ IS = 1 $ IF(AA(1).EQ.PL.OR.AA(1).EQ.DA) IS=2 $ N=0 AAMA1202 + DO 700 J=IS,IG $ K = IG-J $ N = N+ID(AA(J))*10**K AAMA1203 + 700 CONTINUE $ I = N $ IF(AA(1).EQ.DA) I=-I $ RETURN AAMA1204 + 1000 IE = 0 $ DO 1100 J=1,IG $ IF(AA(J).EQ.EE) IE=1 AAMA1205 + 1100 CONTINUE $ IF(IE.EQ.1) GO TO 2000 $ IH = IG+1 $ IFL = 0 AAMA1206 + DO 1200 J=1,IG $ IF(AA(J).EQ.PO) IH = J AAMA1207 + IF(AA(J).EQ.PO) IFL=IFL+1 AAMA1208 + 1200 CONTINUE $ IF(IFL.EQ.1) GO TO 1500 AAMA1209 + IF(IFL.EQ.0) WRITE(IW,1300) AAMA1210 + 1300 FORMAT(/48H *** WARNING *** NO DECIMAL POINT IN REAL NUMBER, AAMA1211 + 1 39H *** ASSUMED TO BE AT THE RIGHT END ***) AAMA1212 + 0 IF(IFL.GT.1) WRITE(IW,1400) AAMA1213 + 1400 FORMAT(/53H *** ERROR *** TOO MANY DECIMAL POINTS IN REAL NUMBERAAMA1214 + 1 ,57H *** LAST ENCOUNTERED ASSUMED, OTHERS CHANGED TO ZERO ***) AAMA1215 + 15000 DO 1800 J=1,IG $ IF(J.EQ.IH) GO TO 1800 $ IFL = 0 AAMA1216 + IF(J.NE.1) GO TO 1600 $ IF(AA(J).EQ.PL.OR.AA(J).EQ.DA) IFL=1 AAMA1217 + 1600 DO 1700 K=1,10 $ IF(AA(J).EQ.BB(K)) IFL=1 AAMA1218 + 1700 CONTINUE $ IF(IFL.EQ.0) WRITE(IW,500)AA(J) AAMA1219 + IF(IFL.EQ.0) AA(J) = BB(1) AAMA1220 + 1800 CONTINUE $ IS = 1 $ IF(AA(1).EQ.PL.OR.AA(1).EQ.DA) IS=2 AAMA1221 + RE = 0.000 $ DO 1900 J=IS,IG $ IF(J.EQ.IH) GO TO 1900 AAMA1222 + K = IH-J-1 $ IF(K.LT.0) K=K+1 AAMA1223 + RE = RE + FLOAT(ID(AA(J)))*10.000**K AAMA1224 + 1900 CONTINUE $ R = RE $ IF(AA(1).EQ.DA) R=-R $ RETURN AAMA1225 + 2000 IH = 0 $ IFL = 0 $ DO 2100 J=1,IG $ IF(AA(J).EQ.PO) IH=J AAMA1226 + IF(AA(J).EQ.PO) IFL=IFL+1 $ IF(AA(J).EQ.EE) IE=J AAMA1227 + 2100 CONTINUE $ IG1 = IE-1 $ IF(IFL.EQ.0) IH=IG1+1 AAMA1228 + IF(IFL.EQ.0) WRITE(IW,1300) $ IF(IFL.GT.1) WRITE(IW,1400) AAMA1229 + IF(IE.EQ.IG) AA(IG+1)=BB(1) $ IF(IE.EQ.IG) IG=IG+1 AAMA1230 + DO 2400 J=1,IG1 $ IF(J.EQ.IH) GO TO 2400 $ IFL = 0 AAMA1231 + IF(J.NE.1) GO TO 2200 $ IF(AA(J).EQ.PL.OR.AA(J).EQ.DA) IFL=1 AAMA1232 + 2200 DO 2300 K=1,10 $ IF(AA(J).EQ.BB(K)) IFL=1 AAMA1233 + 2300 CONTINUE $ IF(IFL.EQ.0) WRITE(IW,500)AA(J) AAMA1234 + IF(IFL.EQ.0) AA(J) = BB(1) AAMA1235 + 2400 CONTINUE $ IS = 1 $ IF(AA(1).EQ.PL.OR.AA(1).EQ.DA) IS=2 AAMA1236 + RE = 0.000 $ DO 2500 J=IS,IG1 $ IF(J.EQ.IH) GO TO 2500 AAMA1237 + K = IH-J-1 $ IF(K.LT.0) K=K+1 AAMA1238 + RE = RE + FLOAT(ID(AA(J)))*10.000**K AAMA1239 + 2500 CONTINUE $ IF(AA(1).EQ.DA) RE=-RE $ IS = IE+1 AAMA1240 + IF(AA(IE+1).EQ.PL.OR.AA(IE+1).EQ.DA) IS=IE+2 $ N = 0 AAMA1241 + DO 2600 J=IS,IG $ K = IG-J $ N = N + ID(AA(J))*10**K AAMA1242 + 2600 CONTINUE $ IF(AA(IE+1).EQ.DA) N=-N $ R = RE*10.000**N $ RETURN AAMA1243 + END AAMA1244 +C-----------------------------------------------------------------------AAMA1245 + 0 SUBROUTINE FFIX $ DOUBLE PRECISION F,DZA,DZA2,DREDM AAMA1246 +C *** INITIALIZES VARIABLES THAT CANNOT BE SIMPLY ASSIGNED IN DATA AAMA1247 + COMMON/LOC001/IJK,ENERGY,ECONS,ECONST,D2P1SM,D2P1S AAMA1248 + COMMON/LOC002/BEM(3),ZSA(3),BE(3) AAMA1249 + COMMON/LOC008/IREAD,IW,IPUNCH,IPRINT $ COMMON/LOC009/F(60),FD AAMA1250 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA1251 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA1252 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC013/COEMON(30),EXPMON(30) AAMA1253 + COMMON/LOC014/COEDIP(42),EXPDIP(42) AAMA1254 + COMMON/LOC015/COEQUA(45),EXPQUA(45) AAMA1255 + COMMON/LOC016/COEOCT(45),EXPOCT(45) AAMA1256 + COMMON/LOC028/M1(7),M2(7),M3(7),YC(4),IDB AAMA1257 + COMMON/LOC030/POP(6),JTM(6),JTD(6),JTQ(6),JTO(6) AAMA1258 + COMMON/LOC031/JM(10),JD(14),JQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA1259 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA1260 + COMMON/LOC034/DZA,DZA2,DREDM AAMA1261 + COMMON/LOC036/ZMK,ZML,ZMM,ZMKM,ZMLM,ZMMM,IVERS AAMA1262 + COMMON/LOC038/A,CFM,TFM,STEP,RMATCH,WIDTHK,IPC(3) AAMA1263 + COMMON/LOC040/AMASSA,AMASSN,HBAR $ DATA AMASSS/206.7686/ AAMA1264 + F(1)=1.000D00 $ DO 100 I=2,60 AAMA1265 + F(I) = F(I-1)*DBLE(FLOAT(I-1))/DBLE(FD) AAMA1266 + 100 CONTINUE $ IF(Z.LT.1.0E-20) WRITE(IW,150) AAMA1267 + 150 FORMAT(52H0*** ERROR *** Z NOT GIVEN, EXECUTION TERMINATED ***) AAMA1268 + 0 IF(Z.LT.1.0E-20) STOP $ IF(IVERS.NE.1) GO TO 160 AAMA1269 + IF(Z-ZSK.LT.0.000.OR.Z-ZSK.GT.ZMKM) ZSK=Z-ZMK AAMA1270 + IF(Z-ZSL.LT.0.000.OR.Z-ZSL.GT.ZMLM) ZSL=Z-ZML AAMA1271 + IF(Z-ZSM.LT.0.000.OR.Z-ZSM.GT.ZMMM) ZSM=Z-ZMM AAMA1272 + 160 IF(Z-ZSK.LT.0.000.OR.Z-ZSK.GT.ZMKM) WRITE(IW,170) AAMA1273 + IF(Z-ZSL.LT.0.000.OR.Z-ZSL.GT.ZMLM) WRITE(IW,180) AAMA1274 + IF(Z-ZSM.LT.0.000.OR.Z-ZSM.GT.ZMMM) WRITE(IW,190) AAMA1275 + 170 FORMAT(53H *** WARNING *** EFFECTIVE CHARGE FOR K SHELL TOO HIG,AAMA1276 + 1 36HH OR TOO LOW *** NO ACTION TAKEN ***) AAMA1277 + 180 FORMAT(53H *** WARNING *** EFFECTIVE CHARGE FOR L SHELL TOO HIG,AAMA1278 + 1 36HH OR TOO LOW *** NO ACTION TAKEN ***) AAMA1279 + 190 FORMAT(53H *** WARNING *** EFFECTIVE CHARGE FOR M SHELL TOO HIG,AAMA1280 + 1 36HH OR TOO LOW *** NO ACTION TAKEN ***) AAMA1281 + IF(ZSK.LT.1.000) ZSK=1.000 $ IF(ZSL.LT.1.000) ZSL=1.000 AAMA1282 + IF(ZSM.LT.1.000) ZSM=1.000 $ ZSKZ = ZSK/Z $ ZSLZ = ZSL/Z AAMA1283 + ZSMZ = ZSM/Z $ AMZZ(1) = ZSKZ/AMASSM $ AMZZ(2) = ZSLZ/AMASSM AAMA1284 + AMZZ(3) = ZSMZ/AMASSM $ ECONST = ECONS*Z*Z $ DO 200 I=1,3 AAMA1285 + BEM(I) = BE(I)/AMASSE AAMA1286 + 200 CONTINUE $ BM = BEM(1)*BEM(2)*BEM(3) AAMA1287 + IF(BM.LT.1.0E-20) WRITE(IW,250)BE AAMA1288 + 250 FORMAT(53H0*** ERROR *** UNDEFINED OR ZERO BINDING ENERGIES ***,AAMA1289 + 1 3F12.3,30H *** EXECUTION TERMINATED ***) AAMA1290 + 0 IF(BM.LT.1.0E-20) STOP $ ZSA(1) = ZSK*ALFA $ ZSA(2) = ZSL*ALFA AAMA1291 + ZSA(3) = ZSM*ALFA $ D2P1SM = D2P1S/AMASSE AAMA1292 + ESPM = ESP/AMASSE $ IF(ABS(AMASSS-AMASSM).LT.1.0E-20) GO TO 600AAMA1293 + DO 300 I=1,30 $ EXPMON(I) = EXPMON(I)/AMASSM*AMASSS AAMA1294 + 300 CONTINUE $ DO 400 I=1,42 $ EXPDIP(I) = EXPDIP(I)/AMASSM*AMASSS AAMA1295 + 400 CONTINUE $ DO 500 I=1,45 $ EXPQUA(I) = EXPQUA(I)/AMASSM*AMASSS AAMA1296 + EXPOCT(I) = EXPOCT(I)/AMASSM*AMASSS AAMA1297 + 500 CONTINUE $ AMASSS = AMASSM AAMA1298 + 600 DZA = DBLE(Z*ALFA) $ DZA2 = DZA**2 $ AME = AMASSE*1.000E-06 AAMA1299 + DREDM = DBLE(A*AMASSN*AMASSM*AME/(A*AMASSN + AMASSM*AME)) AAMA1300 + AMASST = AMASSA*AMASSN AAMA1301 + IF(AMASSA.GT.1.0E-20) DREDM=DBLE(AMASST*AMASSM*AME/(AMASST + AAMA1302 + 1 AMASSM*AME)) $ IF(IYC.EQ.0) GO TO 700 $ YA = 0.0297*Z**0.666667AAMA1303 + YB = 0.0667*SQRT(Z) $ YK = 0.0758*SQRT(Z) $ YD = 0.0850*SQRT(Z) AAMA1304 + YC(1) = AMIN1(YC(1),YA) $ YC(2) = AMIN1(YC(2),YB) AAMA1305 + YC(3) = AMIN1(YC(3),YK) $ YC(4) = AMIN1(YC(4),YD) AAMA1306 + 700 CONTINUE $ IF(CFM.LT.1.0E-20) CFM = 1.100*A**0.333333 AAMA1307 + IF(AMASSA.GT.1.0E-20.AND.ABS(CFM-1.100*A**0.3333).LT.1.0E-20) AAMA1308 + 1 CFM = 1.100*AMASSA**0.333333 $ IF(D2P1S.GT.1.0E-20) GO TO 800 AAMA1309 + R1 = 1.200*A**0.3333 $ X = 2.000E-05*Z*R1*AMASSM/0.529 AAMA1310 + D2P1SM = ECONST*(0.750 + 3.0/X**3*(X*X-4.0-X*X*X/3.0 AAMA1311 + 1 + EXP(-X)*(X*X+4.0+4.0*X))) AAMA1312 + 800 CONTINUE $ IF(IVERS.NE.1) GO TO 900 AAMA1313 + JM(1)=JTM(1) $ JD(1)=JTD(1) $ JQ(1)=JTQ(1) $ JO(1)=JTO(1) AAMA1314 + JM(2)=JTM(2) $ JD(2)=JTD(2) $ JQ(2)=JTQ(2) $ JO(2)=JTO(2) AAMA1315 + JM(3)=JTM(2) $ JD(3)=JTD(2) $ JQ(3)=JTQ(2) $ JO(3)=JTO(2) AAMA1316 + JM(4)=JTM(3) $ JD(4)=JTD(3) $ JQ(4)=JTQ(3) $ JO(4)=JTO(3) AAMA1317 + JD(5)=JTD(3) $ JQ(5)=JTQ(3) $ JO(5)=JTO(3) $ JM(5)=JTM(4) AAMA1318 + JD(6)=JTD(4) $ JQ(6)=JTQ(4) $ JO(6)=JTO(4) $ JM(6)=JTM(4) AAMA1319 + JD(7)=JTD(4) $ JQ(7)=JTQ(4) $ JO(7)=JTO(4) $ JM(7)=JTM(4) AAMA1320 + JD(8)=JTD(4) $ JQ(8)=JTQ(4) $ JO(8)=JTO(4) $ JM(8)=JTM(5) AAMA1321 + JD(9)=JTD(5) $ JQ(9)=JTQ(5) $ JO(9)=JTQ(5) $ JM(9)=JTM(5) AAMA1322 + JD(10)=JTD(5) $ JQ(10)=JTQ(5) $ JO(10)=JTO(5) $ JD(11)=JTD(5) AAMA1323 + JQ(11)=JTQ(5) $ JO(11)=JTO(5) $ JD(12)=JTD(5) $ JQ(12)=JTQ(5) AAMA1324 + JO(12)=JTO(5) $ JM(10)=JTM(6) $ JD(13)=JTD(6) $ JQ(13)=JTQ(6) AAMA1325 + JO(13)=JTO(6) $ JD(14)=JTD(6) $ JQ(14)=JTQ(6) $ JO(14)=JTO(6) AAMA1326 + JQ(15)=JTQ(6) $ JO(15)=JTO(6) AAMA1327 + 900 CONTINUE $ RETURN $ END AAMA1328 +C-----------------------------------------------------------------------AAMA1329 + 0 SUBROUTINE CASCAD AAMA1330 +C *** MAIN CASCADE ROUTINE -- DOES ALL BOOKKEEPING... AAMA1331 + DIMENSION POPT(3),P(3),PC(3,210),PNL(210),POLPOS(210), AAMA1332 + 1 POLNEG(210),WIDTH(210),CONVC(210),SPORB(210),RADNT(20), AAMA1333 + 2 ZT(130),ZK(3,130),ZR(130),ENERGY(19),U(4),ZA0(130),ZA1(130), AAMA1334 + 3 ZA2(130),ZA(130),PC0(210),PC1(210),PC2(210),POP1(6),POP2(6) AAMA1335 + COMMON/LOC001/IJK,ENERG,ECONS,ECONST,D2P1SM,D2P1S AAMA1336 + COMMON/LOC008/IREAD,IW,IPUNCH,IPR AAMA1337 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA1338 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA1339 + COMMON/LOC029/IRR,RR(18),RAU,RAD,RA(4),RD(4),RSA(4) AAMA1340 + COMMON/LOC030/POP(6),JTM(6),JTD(6),JTQ(6),JTO(6) AAMA1341 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA1342 + COMMON/LOC037/PL(20),NPOL(20),IPOL,CL1,CL2,IDE,PLN(210),IP8 AAMA1343 + COMMON/LOC038/A,CFM,TFM,STEP,RMATCH,WIDTHK,IPC(3) AAMA1344 + COMMON/LOC039/NOPT,NMAX,ALEXP $ COMMON/LOC040/AMASSA,AMASSN,HBARAAMA1345 + COMMON/LOC041/MPU,ICPU(200),IPN AAMA1346 + DATA U/3HM+Q,3HD+O,3H Q ,3H O / $ DO 50 I=1,6 $ POP1(I) = POP(I)AAMA1347 + 50 CONTINUE $ POPT(1) = 2.000*POP(1) $ POP2(1) = POP1(1) AAMA1348 + POPT(2) = (2.000*POP(2)+6.000*POP(3)) $ IERROR = 0 $ MAXERR = 99AAMA1349 + POPT(3) = (2.000*POP(4)+6.000*POP(5)+10.000*POP(6)) $ MS = 3 AAMA1350 + POP2(2) = 1.000 $ IF(POPT(2).GT.1.0E-20) POP2(2)=POP2(2)/POPT(2)AAMA1351 + POP2(3) = 1.000 $ IF(POPT(2).GT.1.0E-20) POP2(3)=POP2(3)/POPT(2)AAMA1352 + POP2(4) = 1.000 $ IF(POPT(3).GT.1.0E-20) POP2(4)=POP2(4)/POPT(3)AAMA1353 + POP2(5) = 1.000 $ IF(POPT(3).GT.1.0E-20) POP2(5)=POP2(5)/POPT(3)AAMA1354 + POP2(6) = 1.000 $ IF(POPT(3).GT.1.0E-20) POP2(6)=POP2(6)/POPT(3)AAMA1355 + RLYMAN = 0.000 $ RK = WIDTHK/HBAR $ NU = NMAX*(NMAX+1)/2 AAMA1356 + DO 100 J=1,NU $ PNL(J) = 0.000 AAMA1357 + IF(IP8.NE.0) PNL(J) = PLN(J) $ POLPOS(J) = 0.000 AAMA1358 + POLNEG(J) = 0.000 $ WIDTH(J) = 0.000 $ PC0(J) = 0.000 AAMA1359 + PC1(J) = 0.000 $ PC2(J) = 0.000 $ CONVC(J) = 0.000 AAMA1360 + SPORB(J) = 0.000 $ DO 100 IS=1,MS $ PC(IS,J) = 0.000 AAMA1361 + 100 CONTINUE $ MU = NMAX*(NMAX-1)/2 $ DO 200 J=1,NMAX $ JJ = MU+J AAMA1362 + IF(IP8.EQ.0) PNL(JJ) = PL(J) $ PC1(JJ) = 2.000-2.000*POP(1) AAMA1363 + PC2(JJ) = 2.000*POP(1) - 1.000 $ IF(POP(1).GT.0.500) GO TO 150 AAMA1364 + PC0(JJ)=1.000-2.000*POP(1) $ PC1(JJ)=2.000*POP(1) $ PC2(JJ)=0.00AAMA1365 + 150 IF(PNL(JJ).GT.1.0E-20) POLPOS(JJ)=(1.0 + 2.0/FLOAT(2*J-1))/3.0 AAMA1366 + IF(PNL(JJ).GT.1.0E-20.AND.J.NE.1) POLNEG(JJ)=(1.0 - 2.0/FLOAT( AAMA1367 + 1 2*J-1))/3.0 $ DO 200 IS=1,MS $ PC(IS,JJ) = POPT(IS) AAMA1368 + 200 CONTINUE $ IPR1 = MOD(IPR/4,2) $ IPR2 = MOD(IPR/8,2) AAMA1369 + IPR3 = MOD(IPR/16,2) $ IPR4 = MOD(IPR/32,2) $ DO 4000 I1=1,NMAX AAMA1370 + N1 = NMAX+1-I1 $ IF(N1.EQ.1) GO TO 4000 AAMA1371 + IF(IPR1.EQ.0.AND.N1.GT.3) WRITE(IW,300) AAMA1372 + 300 FORMAT(1H1) AAMA1373 + 0 IF(IPR1.EQ.1) WRITE(IW,400) AAMA1374 + 400 FORMAT(/1X,120(1H*)/) AAMA1375 + 0 IF(IPR1.EQ.0.AND.N1.LE.3) WRITE(IW,450) AAMA1376 + 450 FORMAT(/////) AAMA1377 + 0 CALL CHECK(N1) $ DO 500 I=1,20 $ RADNT(I) = 0.000 AAMA1378 + 500 CONTINUE $ DO 3000 I2=1,N1 $ L1 = I2-1 $ RATEGT = 0.000 AAMA1379 + RATE0 = 2.000*RK $ RATE1 = RK $ RATERD = 0.000 AAMA1380 + K1 = N1*(N1-1)/2 + I2 AAMA1381 + IF(I1.LE.1) GO TO 700 $ IF(PNL(K1).LT.1.0E-20.AND.I1.GT.1) AAMA1382 + 1 GO TO 620 $ XNORM = 1.000/PNL(K1) $ PC0(K1) = PC0(K1)*XNORM AAMA1383 + PC1(K1) = PC1(K1)*XNORM $ PC2(K1) = PC2(K1)*XNORM AAMA1384 + DO 600 IS=2,MS $ PC(IS,K1) = PC(IS,K1)*XNORM AAMA1385 + IF(PC(IS,K1).LE.0.000) PC(IS,K1) = 0.000 AAMA1386 + 600 CONTINUE $ GO TO 640 AAMA1387 + 620 PC(2,K1) = POPT(2) $ PC(3,K1) = POPT(3) AAMA1388 +C *** IF STATE IS NOT POPULADED, THE ELECTRONS ARE AS IN THE BEGINNINGAAMA1389 + PC0(K1) = 0.000 $ PC1(K1) = 2.0-2.0*POP2(1) $ PC2(K1) = 2.0* AAMA1390 + 1 POP2(1) - 1.0 $ IF(POP2(1).GE.0.5) GO TO 630 $ PC0(K1) = 1.0 - AAMA1391 + 2 2.0*POP2(1) $ PC1(K1) = 2.0*POP2(1) $ PC2(K1) = 0.000 AAMA1392 + 630 PC(1,K1) = PC1(K1) + 2.000*PC2(K1) $ GO TO 700 AAMA1393 + 640 PC(1,K1) = PC1(K1) + 2.000*PC2(K1) AAMA1394 + IF(PC(1,K1).LT.0.000) PC(1,K1) = 0.000 AAMA1395 + IF(PC(1,K1).GT.2.000) PC(1,K1) = 2.000 $ DO 650 IS=1,MS AAMA1396 + IF(IPC(IS).NE.0) PC(IS,K1)=POPT(IS) AAMA1397 + 650 CONTINUE AAMA1398 + IF(IPC(1).EQ.0) GO TO 675 $ PC2(K1) = 2.000*POP1(1) - 1.000 AAMA1399 + PC1(K1)=2.-2.*POP1(1) $ PC0(K1)=0. $ IF(POP1(1).GE..5) GO TO 675AAMA1400 + PC2(K1)=0.0 $ PC1(K1)=2.0*POP1(1) $ PC0(K1)=1.0-2.0*POP1(1) AAMA1401 + 675 POLPOS(K1) = POLPOS(K1)*XNORM*FLOAT(2*L1+1)/FLOAT(L1+1) AAMA1402 + IF(NPOL(N1)-L1.LE.1.AND.NPOL(N1)-L1.GE.0) POLPOS(K1) = AAMA1403 + 1 (1.000 + 2.000/FLOAT(2*L1+1))/3.000 $ IF(L1.LE.0) GO TO 700 AAMA1404 + POLNEG(K1) = POLNEG(K1)*XNORM*FLOAT(2*L1+1)/FLOAT(L1) AAMA1405 + IF(NPOL(N1)-L1.LE.1.AND.NPOL(N1)-L1.GE.0) POLNEG(K1) = AAMA1406 + 1 (1.000 - 2.000/FLOAT(2*L1+1))/3.000 AAMA1407 + 700 CONTINUE $ IF(N1.EQ.1) GO TO 3000 $ K = 0 AAMA1408 + IF(IPR2.EQ.0) WRITE(IW,800) $ PC012 = PC0(K1)+PC1(K1)+PC2(K1) AAMA1409 + IF(ABS(PC012-1.000).GT.1.000E-3*FLOAT(I1)) WRITE(IW,850)N1,L1, AAMA1410 + 1 PC0(K1),PC1(K1),PC2(K1) $ IF(ABS(PC012).LT.1.0E-20) PC012=1.000AAMA1411 + PC0(K1) = PC0(K1)/PC012 $ PC1(K1) = PC1(K1)/PC012 AAMA1412 + PC2(K1) = PC2(K1)/PC012 AAMA1413 + 800 FORMAT(//) AAMA1414 + 850 FORMAT(53H0*** WARNING *** PROBABILITIES OF THE POPULATION OF T,AAMA1415 + 1 60HHE K-SHELL ARE SIGNIFICANTLY OFF FROM BEING NORMALIZED PROPE,AAMA1416 + 2 8HRLY. ***/20H *** HAPPENED AT N1=,I2,4H L1=,I2,5H PC0=,1PE12.5,AAMA1417 + 3 5H PC1=,E12.5,5H PC2=,E12.5,24H NORMALIZATION FORCED.../) AAMA1418 + 0 POP(1) = 0.500*PC(1,K1) $ POP(2) = POP2(2)*PC(2,K1) AAMA1419 + POP(3) = POP2(3)*PC(2,K1) $ POP(4) = POP2(4)*PC(3,K1) AAMA1420 + POP(5) = POP2(5)*PC(3,K1) $ POP(6) = POP2(6)*PC(3,K1) AAMA1421 + DO 1100 I3=1,7 $ L2 = L1-4+I3 $ IF(L2.LT.0) GO TO 1100 AAMA1422 + DO 1000 I4=1,N1 $ N2 = N1 - I4 + 1 $ IF(N2.LE.L2) GO TO 1000 AAMA1423 + IF(N2.EQ.N1.AND.(N2.NE.2.OR.L1.NE.0.OR.L2.NE.1)) GO TO 1000 AAMA1424 + IF(N1.EQ.N2.AND.ESPM.LE.1.000E-20) GO TO 1000 $ K = K + 1 AAMA1425 + IF(N1.NE.N2) GO TO 900 $ IJK = 1 $ ENERG = ESPM $ GO TO 950 AAMA1426 + 900 IJK = 0 AAMA1427 + 950 POPQ = POP(1) $ POP(1) = 1.000 AAMA1428 + ZT(K) = RATE(N1,L1,N2,L2) + 1.000E-10 $ RATEGT = RATEGT + ZT(K) AAMA1429 + IF(POP(1).LT.1.0E-20) POP(1)=1.000 $ RSA(1)=RSA(1)/POP(1) AAMA1430 + POP(1) = POPQ $ ZR(K) = RAD AAMA1431 + RATERD = RATERD + RAD $ ZA(K) = RSA(1) $ XR = ZT(K) - RSA(1) AAMA1432 + T0 = XR + 0.500*RSA(1) + RK $ G0 = XR + 2.000*RK + 1.000E-10 AAMA1433 + RATE1 = RATE1+T0-RK +1.000E-10 $ RATE0 = RATE0+XR +1.000E-10 AAMA1434 + XM = ZT(K)-ZA(K)*(PC0(K1)+0.500*PC1(K1)) AAMA1435 + IERR = 0 $ IF(ABS(XM).LT.1.0E-10.OR.ABS(T0).LT.1.0E-10.OR. AAMA1436 + 1 ABS(G0).LT.1.0E-10.OR.ABS(ZT(K)).LT.1.0E-10) IERR = 1 AAMA1437 + IF(IERR.EQ.0) GO TO 995 $ IERROR = IERROR + 1 $ WRITE(IW,960) AAMA1438 + WRITE(IW,990)N1,L1,N2,L2,XM,T0,G0,K,ZT(K),PC0(K1),PC1(K1), AAMA1439 + 1 PC2(K1),ZR(K),XR,ZA(K),ZA0(K),ZA1(K),ZA2(K),YM,XL,ZK(1,K), AAMA1440 + 2 ZK(2,K),ZK(3,K) $ WRITE(IW,970) AAMA1441 + IF(ABS(XM).LT.1.0E-10) XM=1.0 $ IF(ABS(T0).LT.1.0E-10) T0=1.0 AAMA1442 + IF(ABS(G0).LT.1.0E-10) G0=1.0 AAMA1443 + IF(ABS(ZT(K)).LT.1.0E-10) ZT(K)=1.0 AAMA1444 + IF(IERROR.GT.MAXERR) WRITE(IW,980) $ IF(IERROR.GT.MAXERR) STOPAAMA1445 + 960 FORMAT(//51H *** INTERNAL PROGRAM ERROR IN ROUTINE CASCAD *** B,AAMA1446 + 1 60HAD CHOICE OF PARAMETERS HAS RESULTED IN A DIVISION BY ZERO *,AAMA1447 + 2 2H**/55H *** ONE OF THE VARIABLES /XM,T0,G0,ZT(K),RATE0,RATE1,R,AAMA1448 + 3 58HATEGT/ IS ZERO *** NEXT LINES GIVE MORE INFORMATION... ***//)AAMA1449 + 970 FORMAT(//51H *** STANDARD FIXUP TAKEN (ZERO VARIABLE PUT EQUAL ,AAMA1450 + 1 35HTO ONE), EXECUTION CONTINUING ***//) AAMA1451 + 980 FORMAT(//51H *** TOO MANY DIVIDE CHECKS *** EXECUTION TERMINATE,AAMA1452 + 1 17HD --- NO DUMP ***//) AAMA1453 + 990 FORMAT(8H *** N1=,I2,4H L1=,I2,5H, N2=,I2,4H L2=,I2/5X,3HXM=,1PEAAMA1454 + 1 12.5,4H T0=,E12.5,4H G0=,E12.5,5H ZT(,I3,2H)=,E12.5/5X,6HPC0(K1,AAMA1455 + 2 2H)=,E12.5,9H PC1(K1)=,E12.5,9H PC2(K1)=,E12.5/5X,6HZR(K)=,E12.5AAMA1456 + 3 ,4H XR=,E12.5,7H ZA(K)=,E12.5/5X,4HZA0=,E12.5,5H ZA1=,E12.5, AAMA1457 + 4 5H ZA2=,E12.5,4H YM=,E12.5,4H XL=,E12.5/5X,8HZK(1,K)=,E12.5, AAMA1458 + 5 9H ZK(2,K)=,E12.5,9H ZK(3,K)=,E12.5/) AAMA1459 + 995 ZK(3,K) = PC(3,K1) - RSA(3)/XM $ IF(ZK(3,K).LT.0.0) ZK(3,K)=0.0AAMA1460 + ZA2(K) = XR/ZT(K)*(PC2(K1) + RK*PC1(K1)/T0 + 2.000*RK*RK*PC0(K1)AAMA1461 + 1 /T0/G0) AAMA1462 + ZA1(K) = ZA(K)*PC2(K1)/ZT(K) + (XR + RK*ZA(K)/ZT(K))/T0*(PC1(K1)AAMA1463 + 1 + 2.000*RK*PC0(K1)/G0) AAMA1464 + ZA0(K) = PC1(K1)*ZA(K)/(2.000*T0) + PC0(K1)/G0*(XR + RK*ZA(K)/ AAMA1465 + 1 T0) AAMA1466 + YM = ZA(K)*(PC2(K1)/ZT(K) + PC1(K1)*(0.500 + RK/ZT(K))/T0 + PC0 AAMA1467 + 1 (K1)*RK/T0/G0*(1.000 + 2.000*RK/ZT(K))) AAMA1468 + XL = RK*(PC1(K1)/T0 + 2.000*PC0(K1)/T0/G0*(T0 + RK)) AAMA1469 + ZK(1,K) = PC(1,K1) - YM + XL AAMA1470 + ZK(2,K) = PC(2,K1) - RSA(2)/XM - XL AAMA1471 + IF(ZK(1,K).LT.0.00) ZK(1,K)=0. $ IF(ZK(2,K).LT.0.) ZK(2,K)=0.0AAMA1472 + 1000 CONTINUE AAMA1473 + 1100 CONTINUE $ WIDTH(K1) = (RATEGT*PC2(K1) + (RATE1-RK)*PC1(K1) + AAMA1474 + 1 (RATE0-2.0*RK)*PC0(K1))*HBAR $ IF(WIDTH(K1).LT.0.) WIDTH(K1)=0.0AAMA1475 + IERR = 0 $ IF(ABS(RATE0).LT.1.0E-10.OR.ABS(RATE1).LT.1.0E-10.OR.AAMA1476 + 1 ABS(RATEGT).LT.1.0E-10) IERR = 1 $ IF(IERR.EQ.0) GO TO 1175 AAMA1477 + IERROR = IERROR + 1 $ WRITE(IW,960) AAMA1478 + WRITE(IW,1150)N1,L1,RATE0,RATE1,RATEGT $ WRITE(IW,970) AAMA1479 + 1150 FORMAT(8H *** N1=,I2,4H L1=,I2,7H RATE0=,1PE12.5,7H RATE1=,E12.5AAMA1480 + 1 ,8H RATEGT=,E12.5,4H ***/) AAMA1481 + IF(ABS(RATE0).LT.1.0E-10) RATE0 = 1.000 AAMA1482 + IF(ABS(RATE1).LT.1.0E-10) RATE1 = 1.000 AAMA1483 + IF(ABS(RATEGT).LT.1.0E-10) RATEGT = 1.000 AAMA1484 + IF(IERROR.GT.MAXERR) WRITE(IW,980) $ IF(IERROR.GT.MAXERR) STOPAAMA1485 + 1175 CONVC(K1) = RATERD/(WIDTH(K1)/HBAR - RATERD + 1.000E-10) AAMA1486 + IF(CONVC(K1).LT.0.000) CONVC(K1) = 9.999E+99 AAMA1487 + IF(L1.NE.0) SPORB(K1) = 0.150*Z**4/FLOAT(N1**3*L1*(L1+1)) AAMA1488 + K = 0 $ DO 2100 I3=1,7 $ L2 = L1-4+I3 $ IF(L2.LT.0) GO TO 2100 AAMA1489 + DO 2000 I4=1,N1 $ N2 = N1-I4+1 $ IF(N2.LE.L2) GO TO 2000 AAMA1490 + IF(N2.EQ.N1.AND.(N2.NE.2.OR.L1.NE.0.OR.L2.NE.1)) GO TO 2000 AAMA1491 + IF(N2.EQ.N1.AND.ESPM.LE.1.000E-20) GO TO 2000 $ K = K + 1 AAMA1492 + K2 = N2*(N2-1)/2 + L2 + 1 AAMA1493 + BNORM = PNL(K1)*(PC2(K1)*ZT(K)/RATEGT + PC1(K1)*(ZT(K) - 0.500* AAMA1494 + 1 ZA(K) + RK*ZT(K)/RATEGT)/RATE1 + PC0(K1)*(ZT(K) - ZA(K) + 2.000*AAMA1495 + 2 RK/RATE1*(ZT(K) - 0.500*ZA(K) + RK*ZT(K)/RATEGT))/RATE0) AAMA1496 + DO 1200 IS=1,MS $ PC(IS,K2) = PC(IS,K2) + ZK(IS,K)*BNORM AAMA1497 + 1200 CONTINUE $ PNL(K2) = PNL(K2) + BNORM AAMA1498 + PC2(K2) = PC2(K2) + ZA2(K)*BNORM AAMA1499 + PC1(K2) = PC1(K2) + ZA1(K)*BNORM AAMA1500 + PC0(K2) = PC0(K2) + ZA0(K)*BNORM AAMA1501 + RADINT = PNL(K1)*ZR(K)*(PC2(K1)/RATEGT + PC1(K1)*(1.000 + RK/ AAMA1502 + 1 RATEGT)/RATE1 + PC0(K1)*(1.000 + 2.000*RK/RATE1*(1.000 + RK/ AAMA1503 + 2 RATEGT))/RATE0) $ RADNT(N2) = RADNT(N2) + RADINT AAMA1504 +C *** FOR PRINTOUT OF RATES ONLY, SCHROEDINGER ENERGIES ARE USED *** AAMA1505 + ENERGY(N2) = ECONST*(1.000/FLOAT(N2*N2)-1.000/FLOAT(N1*N1)) AAMA1506 + IF(N1.EQ.N2) ENERGY(N2) = ESPM AAMA1507 + IF(N2.EQ.1.AND.D2P1SM.GT.1.0E-20) ENERGY(N2)=ENERGY(N2)+D2P1SM AAMA1508 + 1 -0.750*ECONST $ ENERGY(N2) = ENERGY(N2)*AMASSE AAMA1509 + LL = IABS(L1-L2) $ CALL POPJ(L1,L2,LL,P) AAMA1510 + IF(IPOL.NE.0) GO TO 1500 $ LI = LL + 1 $ J1U = 2*L1 + 1 AAMA1511 + J2U = 2*L2 + 1 $ J1D = J1U - 2 $ J2D = J2U - 2 AAMA1512 + IF(LI.GT.1) GO TO 1300 AAMA1513 + POLPOS(K2) = POLPOS(K2) + BNORM*P(1)*POLPOS(K1) AAMA1514 + POLNEG(K2) = POLNEG(K2) + BNORM*P(2)*POLNEG(K1) $ GO TO 1500 AAMA1515 + 1300 IF(L2.GT.L1) GO TO 1400 AAMA1516 + POLPOS(K2) = POLPOS(K2) + BNORM*(P(1)*POLPOS(K1)*BETA(L1,J1U,L2,AAMA1517 + 1 J2U,LL) + P(2)*POLNEG(K1)*BETA(L1,J1D,L2,J2U,LL)) AAMA1518 + IF(J1D.EQ.-1.OR.J2D.EQ.-1) GO TO 1500 AAMA1519 + POLNEG(K2) = POLNEG(K2) + BNORM*P(3)*POLNEG(K1) AAMA1520 + 1 *BETA(L1,J1D,L2,J2D,LL) $ GO TO 1500 AAMA1521 + 1400 POLPOS(K2) = POLPOS(K2) + BNORM*P(1)*POLPOS(K1) AAMA1522 + 1 *BETA(L1,J1U,L2,J2U,LL) AAMA1523 + POLNEG(K2) = POLNEG(K2) + BNORM*(P(2)*POLPOS(K1)*BETA(L1,J1U,L2,AAMA1524 + 1 J2D,LL) + P(3)*POLNEG(K1)*BETA(L1,J1D,L2,J2D,LL)) AAMA1525 + 1500 LI = LL $ IF(LL.EQ.0) LI = 2 $ LK = LL + 1 AAMA1526 + CALL CODE(N1,L1,N2,L2,LI,RADINT) AAMA1527 + IF(IPR2.EQ.0) WRITE(IW,1600)N1,L1,N2,L2,U(LK),ENERGY(N2),RADINTAAMA1528 + 1600 FORMAT(4H N1=,I2,5H, L1=,I2,5H, N2=,I2,5H, L2=,I2,6H, MUL=,A3, AAMA1529 + 1 4H, E=,-6PF11.8,5H(MEV),6H, RAD=,1PE12.4,10H(PER MUON)) AAMA1530 + 0 IF(L1.EQ.1.AND.L2.EQ.0.AND.N2.EQ.1) RLYMAN = RLYMAN + RADINT AAMA1531 + IF(MPU.LE.0.OR.IPN.NE.0) GO TO 2000 $ DO 1800 IT=1,MPU AAMA1532 + IF(ICPU(IT)/4194304.NE.1) GO TO 1800 $ N1J = MOD(ICPU(IT),32) AAMA1533 + N2J = MOD(ICPU(IT)/2048,32) $ L1J = MOD(ICPU(IT)/32,32) AAMA1534 + L2J = MOD(ICPU(IT)/65536,32) AAMA1535 + IF(N1J.NE.N1.OR.N2J.NE.N2.OR.L1J.NE.L1.OR.L2J.NE.L2) GO TO 1800AAMA1536 + WRITE(IPUNCH,1700)N1,L1,N2,L2,ENERGY(N2),RADINT,IDE AAMA1537 + 1700 FORMAT(2H 1,2I3,4X,2I3,7X,-6PF9.6,1PE12.4,26X,I5) AAMA1538 + 18000 CONTINUE AAMA1539 + 2000 CONTINUE AAMA1540 + 2100 CONTINUE AAMA1541 + 3000 CONTINUE $ IF(IPR3.EQ.0) WRITE(IW,3100) AAMA1542 + 3100 FORMAT(//) AAMA1543 + 0 NO = N1-1 AAMA1544 + IF(IPR3.EQ.0) WRITE(IW,3200)(N1,N2,ENERGY(N2),RADNT(N2),N2=1,NO)AAMA1545 + 3200 FORMAT(4H N1=,I2,5H, N2=,I2,4H, E=,-6PF11.8,5H(MEV),6H, RAD=, AAMA1546 + 1 1PE12.4,12H(NORMALIZED)/) AAMA1547 + 0 IF(MPU.EQ.0.OR.IPN.NE.0) GO TO 4000 $ DO 3400 IT=1,MPU AAMA1548 + IF(ICPU(IT)/4194304.NE.2) GO TO 3400 $ N1J = MOD(ICPU(IT),32) AAMA1549 + N2 = MOD(ICPU(IT)/2048,32) AAMA1550 + IF(N1J.EQ.N1) WRITE(IPUNCH,3300)N1,N2,ENERGY(N2),RADNT(N2),IDE AAMA1551 + 3300 FORMAT(2H 2,I3,7X,I3,10X,-6PF9.6,1PE12.4,26X,I5) AAMA1552 + 34000 CONTINUE AAMA1553 + 4000 CONTINUE $ WRITE(IW,4025)RLYMAN AAMA1554 + 4025 FORMAT(//1H ,60(1H*)/40H LYMAN SERIES (NP-1S) SUM OF INTENSITIESAAMA1555 + 1 ,3H = ,F7.5,10H(PER MUON)/ AAMA1556 + 2 60H DEVIATION FROM UNITY IS THE SUM OF TRANSITION INTENSITIES /AAMA1557 + 3 60H ENDING IN THE 1S STATE NOT THROUGH AN NP-1S RADIATIVE TRAN-/AAMA1558 + 4 60H SITION. EXPERIMENTALLY SET TO UNITY FOR NORMALIZATION /AAMA1559 + 5 1H ,60(1H*)//) AAMA1560 + 0 IF(IPR4.NE.0) RETURN $ WRITE(IW,4050) AAMA1561 + 4050 FORMAT(1H1) AAMA1562 + 0 WRITE(IW,4100) $ PC(1,1) = PC1(1) + 2.000*PC2(1) AAMA1563 + 4100 FORMAT(//51H N1 L1 POPULATION POLAR.UP POLAR.DN WID (EV) ,AAMA1564 + 1 60H RAD/AUG S-O(EV) K-ELECT L-ELECT M-ELECT ***,AAMA1565 + 2 6H**** /1H ,120(1H-)) AAMA1566 + 0 DO 5000 M1=1,NMAX $ N1 = NMAX+1-M1 $ DO 4900 LL1=1,N1 AAMA1567 + L1 = LL1-1 $ K1 = N1*(N1-1)/2 + LL1 AAMA1568 + POLNEG(K1) = -POLNEG(K1)*(FLOAT(L1)+0.5)/(FLOAT(L1)-0.5) AAMA1569 + IF(IPOL.EQ.1) GO TO 4300 AAMA1570 + IF(N1.EQ.1) WRITE(IW,4110)N1,L1,PNL(K1),POLPOS(1),(PC(IS,1), AAMA1571 + 1 IS=1,3) $ IF(N1.EQ.1) GO TO 4900 AAMA1572 + IF(L1.EQ.0.AND.PNL(K1).GT.1.0E-20) WRITE(IW,4120)N1,L1,PNL(K1),AAMA1573 + 1 POLPOS(K1),WIDTH(K1),CONVC(K1),(PC(IS,K1),IS=1,3) AAMA1574 + IF(L1.EQ.0.AND.PNL(K1).GT.1.0E-20) GO TO 4900 AAMA1575 + IF(PNL(K1).LE.1.0E-20) WRITE(IW,4130)N1,L1 $ IF(PNL(K1).LE. AAMA1576 + 1 1.0E-20) GO TO 4900 AAMA1577 + 4110 FORMAT(1X,I2,1H,,I2,1X,1P2E11.3,4(5X,3H***,3X),3E11.3) AAMA1578 + 4120 FORMAT(1X,I2,1H,,I2,1X,1P2E11.3,5X,3H***,3X,2E11.3,5X,3H***,3X, AAMA1579 + 1 3E11.3) AAMA1580 + 4130 FORMAT(1X,I2,1H,,I2,1X,9(5X,3H***,3X),2X,13HNOT POPULATED) AAMA1581 + WRITE(IW,4200)N1,L1,PNL(K1),POLPOS(K1),POLNEG(K1),WIDTH(K1), AAMA1582 + 1 CONVC(K1),SPORB(K1),(PC(IS,K1),IS=1,MS) $ GO TO 4900 AAMA1583 + 4200 FORMAT(1X,I2,1H,,I2,1X,1P10E11.3) AAMA1584 + 4300 IF(N1.EQ.1) WRITE(IW,4400)N1,L1,PNL(K1),(PC(IS,1),IS=1,3) AAMA1585 + IF(N1.EQ.1) GO TO 4900 $ IF(L1.EQ.0.AND.PNL(K1).GT.1.0E-20) AAMA1586 + 1 WRITE(IW,4500)N1,L1,PNL(K1),WIDTH(K1),CONVC(K1),(PC(IS,K1),IS= AAMA1587 + 2 1,3) $ IF(L1.EQ.0.AND.PNL(K1).GT.1.0E-20) GO TO 4900 AAMA1588 + IF(PNL(K1).LE.1.0E-20) WRITE(IW,4130)N1,L1 AAMA1589 + IF(PNL(K1).LE.1.0E-20) GO TO 4900 AAMA1590 + WRITE(IW,4600)N1,L1,PNL(K1),WIDTH(K1),CONVC(K1),SPORB(K1), AAMA1591 + 1 (PC(IS,K1),IS=1,MS) AAMA1592 + 4400 FORMAT(1X,I2,1H,,I2,1X,1PE11.3,5(5X,3H***,3X),3E11.3) AAMA1593 + 4500 FORMAT(1X,I2,1H,,I2,1X,1PE11.3,2(5X,3H***,3X),2E11.3,5X,3H***,3XAAMA1594 + 1 ,3E11.3) AAMA1595 + 4600 FORMAT(1X,I2,1H,,I2,1X,1PE11.3,2(5X,3H***,3X),7E11.3) AAMA1596 + 49000 CONTINUE $ WRITE(IW,4950) AAMA1597 + 4950 FORMAT(1H ,120(1H-)) AAMA1598 + 50000 CONTINUE $ DO 5100 I=1,6 $ POP(I) = POP1(I) AAMA1599 + 5100 CONTINUE $ RETURN $ END AAMA1600 +C-----------------------------------------------------------------------AAMA1601 + 0 SUBROUTINE CODE(N1,L1,N2,L2,L,CC) $ COMMON/LOC008/IR,IW,IP,IPR AAMA1602 +C *** PUTS INFORMATION FOR LINE INTENSITIES IN COMPACT FORM TO SAVE AAMA1603 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA1604 + COMMON/LOC033/M,E(1000),AI(1000),IA(1000),ENERGY(20,40) AAMA1605 + IF((L+L1-L2)/2*2.NE.L+L1-L2) WRITE(IW,100)N1,L1,N2,L2,L AAMA1606 + 100 FORMAT(/50H *** ERROR *** ANGULAR MOMENTA DO NOT MATCH AT N1=,I2AAMA1607 + 1 ,5H, L1=,I2,5H, N2=,I2,5H, L2=,I2,16H, MULTIPOLARITY=,I1,4H ***)AAMA1608 + 0 IF(CC.LE.CLIMIT) RETURN $ IF(M.GT.0995) WRITE(IW,200) AAMA1609 + 200 FORMAT(53H *** ATTENTION *** OVERFLOWING CAPABILITY OF SORTING ,AAMA1610 + 1 50H*** PLEASE RESTRICT CRITERIA FOR LINES TO PASS ***) AAMA1611 + 0 E12 = 0.000E00 $ E22 = 0.000E00 $ E11 = ENERGY(N1,2*L1+1) AAMA1612 + IF(L1.NE.0) E12 = ENERGY(N1,2*L1) $ E21 = ENERGY(N2,2*L2+1) AAMA1613 + IF(L2.NE.0) E22 = ENERGY(N2,2*L2) AAMA1614 + IF(E21-E11.LE.ELOW.AND.N1.NE.N2) RETURN AAMA1615 + IF(E21-E11.GE.EHIGH.AND.N1.NE.N2) RETURN AAMA1616 + IF(N1.NE.N2) GO TO 250 $ E11 = 0.000 AAMA1617 + EZ = 0.500*(ENERGY(2,2)-ENERGY(2,3)) $ E21 = ESP*1.000E-6 - EZ AAMA1618 + E22 = E21 + 2.000*EZ AAMA1619 + 250 IA0 = 4194304*L + 65536*L2 + 2048*N2 + 32*L1 + N1 AAMA1620 + IF(L.LE.0.OR.L.GT.3) WRITE(IW,300)N1,L1,N2,L2,L AAMA1621 + 300 FORMAT(48H *** ERROR *** UNEXPECTED QUANTUM NUMBERS AT N1=,I2, AAMA1622 + 1 5H, L1=,I2,5H, N2=,I2,5H, L2=,I2,4H, L=,I1,4H ***) AAMA1623 + 0 GO TO(1000,2000,3000),L AAMA1624 + 1000 LL = MAX0(L1,L2) $ AN = CC/FLOAT(4*LL*LL-1) $ E(M) = E21-E11 AAMA1625 + IF(L1.EQ.LL) E(M+1)=E21-E12 $ IF(L2.EQ.LL) E(M+1)=E22-E11 AAMA1626 + E(M+2)=E22-E12 $ IA(M) = IA0 + 2098176 AAMA1627 + IF(L1.EQ.LL) IA(M+1) = IA0 + 2097152 AAMA1628 + IF(L2.EQ.LL) IA(M+1) = IA0 + 1024 $ IA(M+2) = IA0 AAMA1629 + AI(M) = AN*FLOAT((LL+1)*(2*LL-1)) $ AI(M+1) = AN AAMA1630 + AI(M+2) = AN*FLOAT((LL-1)*(2*LL+1)) $ M = M + 3 AAMA1631 + IF(LL.EQ.1) M = M-1 $ RETURN AAMA1632 + 2000 IF(L1.EQ.L2) GO TO 2500 $ LL = MAX0(L1,L2) AAMA1633 + AN = CC/FLOAT((2*LL-3)*(2*LL+1)) $ E(M) = E21-E11 AAMA1634 + IF(L1.EQ.LL) E(M+1)=E21-E12 $ IF(L2.EQ.LL) E(M+1)=E22-E11 AAMA1635 + E(M+2) = E22-E12 $ IA(M) = IA0 + 2098176 AAMA1636 + IF(L1.EQ.LL) IA(M+1) = IA0 + 2097152 AAMA1637 + IF(L2.EQ.LL) IA(M+1) = IA0 + 1024 $ IA(M+2) = IA0 AAMA1638 + AI(M) = AN*FLOAT((LL+1)*(2*LL-3)) $ AI(M+1) = 2.000*AN AAMA1639 + AI(M+2) = AN*FLOAT((LL-2)*(2*LL+1)) $ M = M + 3 AAMA1640 + IF(LL.LE.2) M = M-1 $ RETURN AAMA1641 + 2500 IF(L1.EQ.0) RETURN $ AN = CC/FLOAT((2*L1+1)**2) AAMA1642 + E(M) = E21-E11 $ E(M+1) = E22-E11 $ E(M+2) = E21-E12 AAMA1643 + E(M+3) = E22-E12 $ IA(M) = IA0 + 20978176 $ IA(M+1) = IA0 + 1024AAMA1644 + IA(M+2) = IA0 + 2097152 $ IA(M+3) = IA0 AAMA1645 + AI(M) = AN*FLOAT((L1+2)*(2*L1-1)) $ AI(M+1) = 3.000*AN AAMA1646 + AI(M+2) = 3.000*AN $ AI(M+3) = AN*FLOAT((L1-1)*(2*L1+3)) AAMA1647 + M = M + 4 $ IF(L1.EQ.1) M = M-1 $ RETURN AAMA1648 + 3000 IF(IABS(L1-L2).EQ.1) GO TO 3500 $ LL = MAX0(L1,L2) AAMA1649 + AN = CC/FLOAT((2*LL-5)*(2*LL+1)) $ E(M) = E21-E11 AAMA1650 + IF(L1.EQ.LL) E(M+1)=E21-E12 $ IF(L2.EQ.LL) E(M+1)=E22-E11 AAMA1651 + E(M+2) = E22-E12 $ IA(M) = IA0 + 2098176 AAMA1652 + IF(L1.EQ.LL) IA(M+1) = IA0 + 2097152 AAMA1653 + IF(L2.EQ.LL) IA(M+1) = IA0 + 1024 $ IA(M+2) = IA0 AAMA1654 + AI(M) = AN*FLOAT((2*LL-5)*(LL+1)) $ AI(M+1) = 3.000*AN AAMA1655 + AI(M+2) = AN*FLOAT((2*LL+1)*(LL-3)) $ M = M + 3 AAMA1656 + IF(LL.LE.3) M = M-1 $ RETURN AAMA1657 + 3500 LL = MAX0(L1,L2) $ AN = CC/FLOAT(4*LL*LL-1) $ E(M) = E21-E11 AAMA1658 + E(M+1) = E22-E11 $ E(M+2) = E21-E12 $ E(M+3) = E22-E12 AAMA1659 + IA(M) = IA0 + 20978176 $ IA(M+1) = IA0 + 1024 AAMA1660 + IA(M+2) = IA0 + 2097152 $ IA(M+3) = IA0 AAMA1661 + AI(M) = AN*FLOAT((2*LL-3)*(LL+2)) $ AI(M+1) = 5.000*AN AAMA1662 + AI(M+2) = 6.000*AN $ AI(M+3) = AN*FLOAT((2*LL+3)*(LL-2)) AAMA1663 + M = M + 4 $ IF(LL.LE.2) M = M-1 $ RETURN $ END AAMA1664 +C-----------------------------------------------------------------------AAMA1665 + 0 SUBROUTINE SORT $ DIMENSION ST(5),C(5),LL(3) AAMA1666 +C *** ARRANGES LINE INTENSITIES IN ENERGY FOR THE X-RAY TABLE AAMA1667 + COMMON/LOC008/IREAD,IW,IPUNCH,IPRINT AAMA1668 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA1669 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA1670 + COMMON/LOC033/M,E(1000),AI(1000),IA(1000),ENERGY(20,40) AAMA1671 + COMMON/LOC035/ICC,CD(5),EA,EB,IDIR AAMA1672 + COMMON/LOC037/PL(20),NPOL(20),IPOL,CL1,CL2,IDE,PLN(210),IP8 AAMA1673 + COMMON/LOC038/AB,CFM,TFM,STEP,RMATCH,WIDTHK,IPC(3) AAMA1674 + COMMON/LOC041/MPU,ICPU(200),IPX AAMA1675 + DATA STAR,BLANK/1H*,1H /,LL/3HDIP,3HQUA,3HOCT/ AAMA1676 + ICH = 0 $ IF((EA-99.)**2 + (EB-99.)**2.LT.1.000E-20) ICH = 1 AAMA1677 + CC = CLIMIT**(1.000/6.000) $ DO 100 I=1,5 $ C(I) = CC**I AAMA1678 + IF(ICC.NE.0) C(I) = CD(I) AAMA1679 + 100 CONTINUE $ M = M-1 $ IF(M.LE.0) RETURN $ M1 = M $ DO 170 I=1,M AAMA1680 + 120 IF(AI(I).GT.CLIMIT) GO TO 170 $ IF(I.GT.M1) GO TO 170 AAMA1681 + M1 = M1 - 1 $ DO 140 J=I,M1 $ E(J) = E(J+1) $ AI(J) = AI(J+1) AAMA1682 + IA(J) = IA(J+1) AAMA1683 + 140 CONTINUE $ GO TO 120 AAMA1684 + 170 CONTINUE $ M = M1 $ WRITE(IW,200)Z,AB,M AAMA1685 + 200 FORMAT(1H1/1H ,120(1H*)/17H0ATOMIC NUMBER = ,F5.1,4X,6HATOMIC AAMA1686 + 1 ,10H WEIGHT = ,F7.3,4X,18HNUMBER OF LINES = ,I5//1X,120(1H*)/) AAMA1687 + 0 IF(M.EQ.1) GO TO 500 $ MM = M-1 $ DO 400 I=1,MM $ I1 = I+1 AAMA1688 + DO 300 J=I1,M $ IF(E(J).GE.E(I)) GO TO 300 $ E0 = E(J) AAMA1689 + AI0 = AI(J) $ IA0 = IA(J) $ E(J) = E(I) $ AI(J) = AI(I) AAMA1690 + IA(J) = IA(I) $ E(I) = E0 $ AI(I) = AI0 $ IA(I) = IA0 AAMA1691 + 300 CONTINUE AAMA1692 + 400 CONTINUE AAMA1693 + 500 N = 0 $ EE = 0.000 $ AA = 0.000 $ LC = 7 $ DO 1500 I=1,M AAMA1694 + 600 II=I+N $ IF(IA(II)/16777216.EQ.1) GO TO 1500 $ IA0 = IA(II) AAMA1695 + N1 = MOD(IA0,32) $ L1 = MOD(IA0/32,32) AAMA1696 + J1 = (2*L1-1) + 2*MOD(IA0/1024,2) $ N2 = MOD(IA0/2048,32) AAMA1697 + L2 = MOD(IA0/65536,32) $ J2 = (2*L2-1) + 2*MOD(IA0/2097152,2) AAMA1698 + L = MOD(IA0/4194304,4) $ L = LL(L) $ EN = 1000.000*E(II) AAMA1699 + A = AI(II) $ CH = (EN-EA)/AMIN1(EB,1.000E+20) $ DO 700 K=1,5 AAMA1700 + ST(K)=BLANK $ IF(A.GT.C(K)) ST(K)=STAR AAMA1701 + 700 CONTINUE $ IF(ICH.EQ.0) WRITE(IW,800)N1,L1,J1,N2,L2,J2,L,EN,A, AAMA1702 + 1 ST,CH $ IF(ICH.EQ.1) WRITE(IW,805)N1,L1,J1,N2,L2,J2,L,EN,A,ST AAMA1703 + 800 FORMAT(4H N1=,I2,4H,L1=,I2,4H,J1=,I2,9H/2 N2=,I2,4H,L2=,I2, AAMA1704 + 1 4H,J2=,I2,8H/2 L=,A3,7H EN=,F12.6,13H(KEV) INT=,1PE11.4AAMA1705 + 2 ,4X,5A1,4X,3HCH=,0PF9.3) AAMA1706 + 805 FORMAT(4H N1=,I2,4H,L1=,I2,4H,J1=,I2,9H/2 N2=,I2,4H,L2=,I2, AAMA1707 + 1 4H,J2=,I2,8H/2 L=,A3,7H EN=,F12.6,13H(KEV) INT=,1PE11.4AAMA1708 + 2 ,4X,5A1) AAMA1709 + 0 LC = LC + 1 $ IF(MPU.LE.0) GO TO 830 $ IF(IPX.NE.0) GO TO 830 AAMA1710 + DO 820 IT=1,MPU $ IF(ICPU(IT)/4194304.NE.0) GO TO 820 AAMA1711 + N1J = MOD(ICPU(IT),32) $ N2J = MOD(ICPU(IT)/2048,32) AAMA1712 + L1J = MOD(ICPU(IT)/32,32) $ L2J = MOD(ICPU(IT)/65536,32) AAMA1713 + J1J = MOD(ICPU(IT)/1024,2) $ J2J = MOD(ICPU(IT)/2097152,2) AAMA1714 + J1K = 2*L1J-1 + 2*J1J $ J2K = 2*L2J-1 + 2*J2J AAMA1715 + IF(N1J.NE.N1.OR.N2J.NE.N2.OR.L1J.NE.L1.OR.L2J.NE.L2.OR.J1K.NE. AAMA1716 + 1 J1.OR.J2K.NE.J2) GO TO 820 AAMA1717 + WRITE(IPUNCH,810)N1,L1,J1J,N2,L2,J2J,EN,A,IDE AAMA1718 + 810 FORMAT(2H 0,2I3,I2,2X,2I3,I2,5X,-3PF9.6,1PE12.4,26X,I5) AAMA1719 + 8200 CONTINUE AAMA1720 + 830 IF(LC.GE.60) WRITE(IW,850) AAMA1721 + 850 FORMAT(1H1) AAMA1722 + 0 IF(LC.GE.60) LC=0 $ IA(II) = IA(II)+16777216 $ EE = EE+E(II)*A AAMA1723 + AA = AA+A AAMA1724 + 900 N = N+1 $ IPN = I+N $ IF(E(IPN)-E(I).GE.ERES) GO TO 1000 AAMA1725 + IF(IA(IPN)/16777216.EQ.1) GO TO 900 $ N11 = MOD(IA(IPN),32) AAMA1726 + N22 = MOD(IA(IPN)/2048,32) AAMA1727 + IF(N1.EQ.N11.AND.N2.EQ.N22) GO TO 600 AAMA1728 + 1000 IF(ABS(A-AA).LT.1.0E-20) GO TO 1300 $ EN = 1000.000*EE/AA AAMA1729 + CH = (EN-EA)/AMIN1(EB,1.000E+20) $ DO 1100 K=1,5 $ ST(K) = BLANKAAMA1730 + IF(AA.GT.C(K)) ST(K)=STAR AAMA1731 + 1100 CONTINUE $ IF(ICH.EQ.0) WRITE(IW,1200)N1,N2,EN,AA,ST,CH AAMA1732 + IF(ICH.EQ.1) WRITE(IW,1250)N1,N2,EN,AA,ST AAMA1733 + 1200 FORMAT(4H N1=,I2,1X,13(1H-),4X,3HN2=,I2,1X,13(1H-),10X,6HAV.EN=,AAMA1734 + 1 F12.6,13H(KEV) TOT.IN=,1PE11.4,4X,5A1,7H AV.CH=,0PF9.3) AAMA1735 + 1250 FORMAT(4H N1=,I2,1X,13(1H-),4X,3HN2=,I2,1X,13(1H-),10X,6HAV.EN=,AAMA1736 + 1 F12.6,13H(KEV) TOT.IN=,1PE11.4,4X,5A1) AAMA1737 + 0 LC = LC + 1 $ IF(LC.GE.60) WRITE(IW,850) $ IF(LC.GE.60) LC=0 AAMA1738 + 1300 WRITE(IW,1400) AAMA1739 + 1400 FORMAT(1H ) AAMA1740 + 0 LC = LC + 1 $ IF(LC.GE.60) WRITE(IW,850) $ IF(LC.GE.60) LC=0 AAMA1741 + N = 0 $ AA = 0.000 $ EE = 0.000 AAMA1742 + 1500 CONTINUE $ RETURN $ END AAMA1743 +C-----------------------------------------------------------------------AAMA1744 + 0 FUNCTION RATE(N1,L1,N2,L2) AAMA1745 +C *** MASTER RATE ROUTINE -- INTERPRETS OPTIONS AND CALLS OTHER RATES AAMA1746 +C *** POINT DIRAC OR INPUTED ENERGIES USED EXCLUSIVELY IN RATES *** AAMA1747 + DIMENSION Y(3),IY(3),IP1(7),IP2(7),IP3(7),IDM(3),IDD(5,5), AAMA1748 + 1 IDQ(4,4),IDO(4,4),IDR(18) AAMA1749 + COMMON/LOC001/IJK,ENERGY,ECONS,ECONST,D2P1SM,D2P1S AAMA1750 + COMMON/LOC002/BEM(3),ZSA(3),BE(3) $ COMMON/LOC003/K0,K1,K2,K3 AAMA1751 + COMMON/LOC004/NN0(3),NN1(7),NN2(7),NN3(7) AAMA1752 + COMMON/LOC005/R0(3),R1(7),R2(7),R3(7) AAMA1753 + COMMON/LOC006/JP1(7),JP2(7),JP3(7),IQ1(7),IQ2(7),IQ3(7) AAMA1754 + COMMON/LOC008/IREAD,IW,IPUNCH,IPRINT AAMA1755 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA1756 + COMMON/LOC028/M1(7),M2(7),M3(7),YC(4),IDB AAMA1757 + COMMON/LOC029/IRR,RR(18),RAU,RAD,RA(4),RD(4),RSA(4) AAMA1758 + COMMON/LOC033/M,E(1000),AI(1000),IA(1000),ENE(20,40) AAMA1759 + DATA IDM/4HM-1T,4HM-2T,4HM-3T/ AAMA1760 + DATA IDD/4HD-RT,4HD-1T,4HD-2T,4HD-3T,4H****,4H****,4HD-1S,4HD-2SAAMA1761 + 1 ,4HD-3S,4H****,2*4H****,4HD-2P,4HD-3P,4H****,3*4H****,4HD-3D, AAMA1762 + 2 4H****,4*4H****,4H****/ AAMA1763 + DATA IDQ/4HQ-RT,4HQ-1T,4HQ-2T,4HQ-3T,4H****,4HQ-1S,4HQ-2S,4HQ-3SAAMA1764 + 1 ,2*4H****,4HQ-2P,4HQ-3P,3*4H****,4HQ-3D/ AAMA1765 + DATA IDO/4H8-RT,4H8-1T,4H8-2T,4H8-3T,4H****,4H8-1S,4H8-2S,4H8-3SAAMA1766 + 1 ,2*4H****,4H8-2P,4H8-3P,3*4H****,4H8-3D/ $ IRR = 0 AAMA1767 + N12 = (N1+N2+1)/2 $ RATE = 0.000 $ RAU = 0.000 $ RAD = 0.000 AAMA1768 + DO 50 I=1,4 $ RA(I) = 0.000 $ RD(I) = 0.000 $ RSA(I) = 0.000 AAMA1769 + 50 CONTINUE $ L = IABS(L1-L2)+1 $ IF(L.GT.4) RETURN AAMA1770 + ENEM = ENERGY $ IF(IJK.NE.0) GO TO 100 AAMA1771 + LL1 = 1 $ LL2 = 1 $ IF(L1.EQ.0) LL1=0 $ IF(L2.EQ.0) LL2=0 AAMA1772 + LJ11=2*L1+1 $ LJ12=LJ11-LL1 $ LJ21=2*L2+1 $ LJ22=LJ21-LL2 AAMA1773 + ENE1 = 0.500*(ENE(N1,LJ11) + ENE(N1,LJ12)) AAMA1774 + ENE2 = 0.500*(ENE(N2,LJ21) + ENE(N2,LJ22)) AAMA1775 + IF(N2.EQ.1.AND.D2P1SM.GT.1.000E-20) ENE2=D2P1SM*AMASSE*1.0E-6 +AAMA1776 + 1 0.500*(ENE(2,2) + ENE(2,3)) $ ENEM = (ENE2-ENE1)*1.000E6/AMASSE AAMA1777 + 100 DO 200 I=1,3 $ IY(I) = 1 $ T = ENEM-BEM(I) AAMA1778 + IF(T.LE.0.000) GO TO 200 $ IY(I) = 0 AAMA1779 + Y(I) = ZSA(I)/SQRT(T*T+2.000*T) AAMA1780 + 200 CONTINUE $ GO TO (1000,2000,3000,4000),L AAMA1781 + 1000 IF(K0.EQ.0) GO TO 3000 $ DO 1100 I=1,K0 $ R0(I) = 0.000 AAMA1782 + NN = NN0(I) $ IF(IY(NN).NE.0) GO TO 1100 AAMA1783 + IF(Y(NN).LT.YC(NN)) GO TO 1100 AAMA1784 + R0(I) = RMON(N1,L1,N2,L2,NN,Y(NN)) $ RATE = RATE+R0(I) AAMA1785 + RAU = RAU+R0(I) $ IRR = IRR+1 $ RR(IRR) = R0(I) AAMA1786 + IF(NN.EQ.0) GO TO 1100 $ RSA(NN) = RSA(NN) + R0(I) AAMA1787 + IDR(IRR) = IDM(NN) AAMA1788 + 1100 CONTINUE $ RA(1) = RAU $ GO TO 3000 AAMA1789 + 2000 IF(K1.EQ.0) GO TO 4000 $ DO 2100 I=1,K1 $ R1(I) = 0.000 AAMA1790 + NN = NN1(I) $ MM = NN $ IF(MM.EQ.0) MM=1 $ IP1(I) = 0 AAMA1791 + IF(NN.EQ.0) GO TO 2050 $ IF(IY(NN).NE.0) GO TO 2100 AAMA1792 + IF(Y(NN).GT.YC(NN)) IP1(I) = JP1(I) AAMA1793 + 2050 IF(IP1(I).EQ.0) R1(I)=RDIPU(N1,L1,N2,L2,NN,ENEM,Y(MM),M1(I)) AAMA1794 + IF(NN.EQ.0) GO TO 2075 AAMA1795 + IF(IP1(I).NE.0.AND.N12.GE.IQ1(I)) R1(I) = RDIP(N1,L1,N2,L2,NN, AAMA1796 + 1 M1(I),Y(MM)) AAMA1797 + IF(IP1(I).NE.0.AND.N12.LT.IQ1(I)) R1(I) = RDIPU(N1,L1,N2,L2,NN,AAMA1798 + 1 ENEM,Y(MM),M1(I)) AAMA1799 + 2075 RATE = RATE+R1(I) $ IF(NN.EQ.0) RAD=RAD+R1(I) AAMA1800 + IF(NN.NE.0) RAU=RAU+R1(I) $ IRR = IRR+1 $ RR(IRR) = R1(I) AAMA1801 + MN = M1(I) + 1 $ IF(NN.EQ.0) MN = 1 $ IDR(IRR) = IDD(NN+1,MN) AAMA1802 + IF(NN.EQ.0) GO TO 2100 $ RSA(NN) = RSA(NN) + R1(I) AAMA1803 + 2100 CONTINUE $ RD(2) = RAD $ RA(2) = RAU $ GO TO 4000 AAMA1804 + 3000 IF(K2.EQ.0.OR.L1+L2.EQ.0) GO TO 5000 $ DO 3100 I=1,K2 AAMA1805 + R2(I) = 0.000 $ NN = NN2(I) $ MM = NN $ IF(MM.EQ.0) MM=1 AAMA1806 + IP2(I) = 0 $ IF(NN.EQ.0) GO TO 3050 AAMA1807 + IF(IY(NN).NE.0) GO TO 3100 AAMA1808 + IF(Y(NN).GT.YC(NN)) IP2(I) = JP2(I) AAMA1809 + 3050 IF(IP2(I).EQ.0) R2(I)=RQUAU(N1,L1,N2,L2,NN,ENEM,Y(MM),M2(I)) AAMA1810 + IF(NN.EQ.0) GO TO 3075 AAMA1811 + IF(IP2(I).NE.0.AND.N12.GE.IQ2(I)) R2(I)=RQUA(N1,L1,N2,L2,NN, AAMA1812 + 1 M2(I),Y(MM)) AAMA1813 + IF(IP2(I).NE.0.AND.N12.LT.IQ2(I)) R2(I)=RQUAU(N1,L1,N2,L2,NN, AAMA1814 + 1 ENEM,Y(MM),M2(I)) AAMA1815 + 3075 RATE = RATE+R2(I) $ IF(NN.EQ.0) RD(3)=RD(3)+R2(I) AAMA1816 + IF(NN.EQ.0) RAD=RAD+R2(I) $ IF(NN.NE.0) RA(3)=RA(3)+R2(I) AAMA1817 + IF(NN.NE.0) RAU=RAU+R2(I) $ IRR = IRR+1 $ RR(IRR) = R2(I) AAMA1818 + MN = M2(I) + 1 $ IF(NN.EQ.0) MN = 1 $ IDR(IRR) = IDQ(NN+1,MN) AAMA1819 + IF(NN.EQ.0) GO TO 3100 $ RSA(NN) = RSA(NN) + R2(I) AAMA1820 + 3100 CONTINUE $ GO TO 5000 AAMA1821 + 4000 IF(K3.EQ.0.OR.L1+L2.EQ.1) GO TO 5000 $ DO 4100 I=1,K3 AAMA1822 + R3(I) = 0.000 $ NN = NN3(I) $ MM = NN $ IF(MM.EQ.0) MM=1 AAMA1823 + IP3(I) = 0 $ IF(NN.EQ.0) GO TO 4050 AAMA1824 + IF(IY(NN).NE.0) GO TO 4100 AAMA1825 + IF(Y(MM).GT.YC(NN)) IP3(I) = JP3(I) AAMA1826 + 4050 IF(IP3(I).EQ.0) R3(I)=ROCTU(N1,L1,N2,L2,NN,ENEM,Y(MM),M3(I)) AAMA1827 + IF(NN.EQ.0) GO TO 4075 AAMA1828 + IF(IP3(I).NE.0.AND.N12.GE.IQ3(I)) R3(I)=ROCT(N1,L1,N2,L2,NN, AAMA1829 + 1 M3(I),Y(MM)) AAMA1830 + IF(IP3(I).NE.0.AND.N12.LT.IQ3(I)) R3(I)=ROCTU(N1,L1,N2,L2,NN, AAMA1831 + 1 ENEM,Y(MM),M3(I)) AAMA1832 + 4075 IF(NN.EQ.0) RD(4)=RD(4)+R3(I) $ IF(NN.EQ.0) RAD=RAD+R3(I) AAMA1833 + IF(NN.NE.0) RA(4)=RA(4)+R3(I) $ IF(NN.NE.0) RAU=RAU+R3(I) AAMA1834 + RATE = RATE+R3(I) $ IRR = IRR+1 $ RR(IRR) = R3(I) AAMA1835 + MN = M3(I) + 1 $ IF(NN.EQ.0) MN = 1 $ IDR(IRR) = IDO(NN+1,MN) AAMA1836 + IF(NN.EQ.0) GO TO 4100 $ RSA(NN) = RSA(NN) + R3(I) AAMA1837 + 4100 CONTINUE AAMA1838 + 5000 IF(IDB.EQ.0) GO TO 5400 $ IF(IRR.EQ.0) GO TO 5200 AAMA1839 + WRITE(IW,5100)N1,L1,N2,L2,Y,RATE,(IDR(I),RR(I),I=1,IRR) AAMA1840 + 5100 FORMAT(1X,I2,1H,,I2,3H - ,I2,1H,,I2,3F7.3,1PE10.3 /7(1X,A4, AAMA1841 + 1 1PE12.4)) AAMA1842 + 52000 IF(IRR.EQ.0) WRITE(IW,5300)N1,L1,N2,L2,Y AAMA1843 + 5300 FORMAT(1X,I2,1H,,I2,3H - ,I2,1H,,I2,3F7.3,14H ***NO RATE***) AAMA1844 + 5400 IF(IRR.EQ.0) RETURN $ DO 5500 I=1,IRR AAMA1845 + IF(RR(I).LT.0.000) WRITE(IW,5600)N1,L1,N2,L2,I,RR(I) AAMA1846 + 5500 CONTINUE AAMA1847 + 5600 FORMAT(53H *** ERROR *** IN INTERNAL CALCULATION OF TRANSITION ,AAMA1848 + 1 12HRATES AT N1=,I2,4H L1=,I2,5H, N2=,I2,4H L2=,I2,9H RATE NO=,I2AAMA1849 + 2 ,7H RATE =,1PE13.5,4H ***) AAMA1850 + 0 RETURN $ END AAMA1851 +C-----------------------------------------------------------------------AAMA1852 + 0 FUNCTION RMON(N1,L1,N2,L2,N,Y) $ INTEGER F $ REAL MATEL AAMA1853 +C *** MONOPOLE RATE ROUTINE (PENETRATION ONLY) AAMA1854 + DIMENSION JM(10) AAMA1855 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFFF,ALFA,AMASSE AAMA1856 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA1857 + COMMON/LOC013/COEMON(30),EXPMON(30) $ COMMON/LOC017/F(6) AAMA1858 + COMMON/LOC030/POP(6),DUM(24) AAMA1859 + COMMON/LOC031/KM(10),JD(14),JQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA1860 + EPIY = EXP(PI*Y) $ COEFF = PICOEF*2.000*EPIY/(EPIY-1.000/EPIY) AAMA1861 + DO 500 JJ=1,10 $ JM(JJ) = KM(JJ) AAMA1862 + 500 CONTINUE $ IF(IJ(1).EQ.0) GO TO 900 $ DO 600 JJ=1,10 AAMA1863 + IF(Y.GT.YJ(1)) JM(JJ)=MIN0(KM(JJ),JJ1(1)) AAMA1864 + 600 CONTINUE AAMA1865 + 900 GO TO (1000,2000,3000),N AAMA1866 + 1000 A1=0.000 $ IF(F(1).EQ.1) RETURN $ DO 1100 JJ=1,3 AAMA1867 + IF(JJ.GT.JM(1)) GO TO 1100 $ J=JK(JJ) $ B=Y**NE(JJ) AAMA1868 + A1=A1+COEMON(JJ)*MATEL(N1,L1,N2,L2,J+2,EXPMON(JJ),1)/B AAMA1869 + 1100 CONTINUE $ RMON=A1*A1*COEFF*POP(1) $ RETURN AAMA1870 + 2000 A1=0.000 $ A2=0.000 $ A3=0.000 $ YY=(1.000+Y*Y)/(Y*Y) AAMA1871 + IF(F(2)+F(3).EQ.2) RETURN $ DO 2200 JJ=1,3 $ J=JK(JJ) AAMA1872 + B=Y**NE(JJ) $ IF(F(2).EQ.1) GO TO 2100 AAMA1873 + IF(JJ.GT.JM(2)) GO TO 2100 AAMA1874 + A1=A1+COEMON(JJ+3)*MATEL(N1,L1,N2,L2,J+2,EXPMON(JJ+3),2)/B AAMA1875 + 2100 IF(F(3).EQ.1) GO TO 2200 $ IF(JJ.GT.JM(3)) GO TO 2150 AAMA1876 + A2=A2+COEMON(JJ+ 6)*MATEL(N1,L1,N2,L2,J+3,EXPMON(JJ+ 6),2)/B AAMA1877 + 2150 IF(JJ.GT.JM(4)) GO TO 2200 AAMA1878 + A3=A3+COEMON(JJ+ 9)*MATEL(N1,L1,N2,L2,J+4,EXPMON(JJ+ 9),2)/B AAMA1879 + 2200 CONTINUE $ RMON=((A1+A2)**2*POP(2)+A3*A3*YY*POP(3))*COEFF AAMA1880 + RETURN AAMA1881 + 3000 A1=0.000 $ A2=0.000 $ A3=0.000 $ A4=0.000 $ A5=0.000 $ A6=0.000 AAMA1882 + YY1=(1.000+Y*Y)/(Y*Y) $ YY2=(1.000+Y*Y)*(4.000+Y*Y)/Y**4 AAMA1883 + IF(F(4)+F(5)+F(6).EQ.3) RETURN $ DO 3300 JJ=1,3 $ J=JK(JJ) AAMA1884 + B=Y**NE(JJ) $ IF(F(4).EQ.1) GO TO 3100 AAMA1885 + IF(JJ.GT.JM(5)) GO TO 3100 AAMA1886 + A1=A1+COEMON(JJ+12)*MATEL(N1,L1,N2,L2,J+2,EXPMON(JJ+12),3)/B AAMA1887 + 3100 IF(F(5).EQ.1) GO TO 3200 $ IF(JJ.GT.JM(6)) GO TO 3150 AAMA1888 + A2=A2+COEMON(JJ+15)*MATEL(N1,L1,N2,L2,J+3,EXPMON(JJ+15),3)/B AAMA1889 + 3150 IF(JJ.GT.JM(7)) GO TO 3200 AAMA1890 + A3=A3+COEMON(JJ+18)*MATEL(N1,L1,N2,L2,J+4,EXPMON(JJ+18),3)/B AAMA1891 + 3200 IF(F(6).EQ.1) GO TO 3300 $ IF(JJ.GT.JM(8)) GO TO 3230 AAMA1892 + A4=A4+COEMON(JJ+21)*MATEL(N1,L1,N2,L2,J+4,EXPMON(JJ+21),3)/B AAMA1893 + 3230 IF(JJ.GT.JM(9)) GO TO 3260 AAMA1894 + A5=A5+COEMON(JJ+24)*MATEL(N1,L1,N2,L2,J+5,EXPMON(JJ+24),3)/B AAMA1895 + 3260 IF(JJ.GT.JM(10)) GO TO 3300 AAMA1896 + A6=A6+COEMON(JJ+27)*MATEL(N1,L1,N2,L2,J+6,EXPMON(JJ+27),3)/B AAMA1897 + 3300 CONTINUE $ RMON=((A1+A2+A3)**2*POP(4)+YY1*(A4+A5)**2*POP(5)+ AAMA1898 + 1 YY2*A6*A6*POP(6))*COEFF $ RETURN $ END AAMA1899 +C-----------------------------------------------------------------------AAMA1900 + 0 FUNCTION RDIP(N1,L1,N2,L2,N,M,Y) $ DIMENSION A(5),JD(14) AAMA1901 +C *** DIPOLE PENETRATION ROUTINE AAMA1902 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA1903 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA1904 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC014/COEDIP(42),EXPDIP(42) AAMA1905 + COMMON/LOC018/F(9) $ COMMON/LOC021/ANGD,ANGQ,ANGO AAMA1906 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA1907 + COMMON/LOC023/COEDP(9) $ COMMON/LOC030/POP(6),DUM(24) AAMA1908 + COMMON/LOC031/JM(10),KD(14),JQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA1909 + INTEGER F $ REAL MATEL $ ETPY = EXP(2.000*PI*Y) AAMA1910 + EXTPY = ETPY/(ETPY-1.000) $ YY = Y*Y AAMA1911 + P = EXP(Y*(2.000*ATAN(Y/FLOAT(N))-PI)) $ DO 500 I=1,5 AAMA1912 + A(I)=0.000 AAMA1913 + 500 CONTINUE $ DO 550 JJ=1,14 $ JD(JJ) = KD(JJ) AAMA1914 + 550 CONTINUE $ IF(IJ(2).EQ.0) GO TO 900 $ DO 600 JJ=1,14 AAMA1915 + IF(Y.GT.YJ(2)) JD(JJ) = MIN0(KD(JJ),JJ1(2)) AAMA1916 + 600 CONTINUE AAMA1917 + 900 GO TO (1000,2000,3000),N AAMA1918 + 1000 A1 = 0.000 $ IF(F(1).EQ.1) GO TO 1200 $ DO 1100 JJ=1,3 AAMA1919 + IF(JJ.GT.JD(1)) GO TO 1100 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA1920 + A1 = A1+COEDIP(JJ)*MATEL(N1,L1,N2,L2,J+3,EXPDIP(JJ),1)/B AAMA1921 + 1100 CONTINUE AAMA1922 + 1200 YF = YY/(1.0+YY) $ YG = (1.0+YY)/YY AAMA1923 + RDIP = COEDP(1)*EXTPY*PICOEF*ANGD*YG*(YF*P*AID*AMZZ(1)-A1)**2 AAMA1924 + RDIP = RDIP*POP(1) $ RETURN AAMA1925 + 2000 A1 =0.000 $ A2 = 0.000 $ A3 = 0.000 $ IF(M.EQ.2) GO TO 2300 AAMA1926 + IF(F(2).EQ.1) GO TO 2200 $ DO 2100 JJ=1,3 $ J = JK(JJ) AAMA1927 + B = Y**NE(JJ) $ IF(JJ.GT.JD(2)) GO TO 2050 AAMA1928 + A1 = A1+COEDIP(JJ+3)*MATEL(N1,L1,N2,L2,J+3,EXPDIP(JJ+3),2)/B AAMA1929 + 2050 IF(JJ.GT.JD(3)) GO TO 2100 AAMA1930 + A1 = A1+COEDIP(JJ+ 6)*MATEL(N1,L1,N2,L2,J+4,EXPDIP(JJ+ 6),2)/B AAMA1931 + 2100 CONTINUE AAMA1932 + 2200 YF = YY/(4.0+YY) $ YG = (1.0+YY)/YY AAMA1933 + A(1) = COEDP(2)*POP(2)*EXTPY*YG*(YF*P*AID*AMZZ(2)-A1)**2 AAMA1934 + 2300 IF(M.EQ.1) GO TO 2600 $ IF(F(3)+F(4).EQ.2) GO TO 2500 AAMA1935 + DO 2400 JJ=1,3 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA1936 + IF(JJ.GT.JD(4)) GO TO 2350 AAMA1937 + A2 = A2+COEDIP(JJ+ 9)*MATEL(N1,L1,N2,L2,J+3,EXPDIP(JJ+ 9),2)/B AAMA1938 + 2350 IF(JJ.GT.JD(5)) GO TO 2400 AAMA1939 + A3 = A3+COEDIP(JJ+12)*MATEL(N1,L1,N2,L2,J+5,EXPDIP(JJ+12),2)/B AAMA1940 + 2400 CONTINUE AAMA1941 + 2500 YF = YY/(4.0+YY) AAMA1942 + A(2)=COEDP(3)*POP(3)*EXTPY*(YF*P*AID*AMZZ(2)-A2)**2 AAMA1943 + YF = YY*YY/(4.0+YY)**2 $ YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA1944 + A(3) = COEDP(4)*POP(3)*EXTPY*YG*(YF*P*AID*AMZZ(2)-A3)**2 AAMA1945 + 2600 AT = A(1)+A(2)+A(3) $ RDIP = PICOEF*ANGD*AT $ RETURN AAMA1946 + 3000 A1 = 0.000 $ A2 = 0.000 $ A3 = 0.000 $ A4 = 0.000 $ A5 = 0.000 AAMA1947 + IF(M.GT.1) GO TO 3300 $ IF(F(5).EQ.1) GO TO 3200 AAMA1948 + DO 3100 JJ=1,3 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA1949 + IF(JJ.GT.JD(6)) GO TO 3030 AAMA1950 + A1 = A1+COEDIP(JJ+15)*MATEL(N1,L1,N2,L2,J+3,EXPDIP(JJ+15),3)/B AAMA1951 + 3030 IF(JJ.GT.JD(7)) GO TO 3060 AAMA1952 + A1 = A1+COEDIP(JJ+18)*MATEL(N1,L1,N2,L2,J+4,EXPDIP(JJ+18),3)/B AAMA1953 + 3060 IF(JJ.GT.JD(8)) GO TO 3100 AAMA1954 + A1 = A1+COEDIP(JJ+21)*MATEL(N1,L1,N2,L2,J+5,EXPDIP(JJ+21),3)/B AAMA1955 + 3100 CONTINUE AAMA1956 + 3200 YF = YY*(27.0+7.0*YY)/(9.0+YY)**2 $ YG = (1.0+YY)/YY AAMA1957 + A(1)=COEDP(5)*POP(4)*EXTPY*YG*(YF*P*AID*AMZZ(3)-A1)**2 AAMA1958 + 3300 IF(M.NE.0.AND.M.NE.2) GO TO 3600 AAMA1959 + IF(F(6)+F(7).EQ.2) GO TO 3500 $ DO 3400 JJ=1,3 $ J = JK(JJ) AAMA1960 + B = Y**NE(JJ) $ IF(JJ.GT.JD(9)) GO TO 3325 AAMA1961 + A2 = A2+COEDIP(JJ+24)*MATEL(N1,L1,N2,L2,J+3,EXPDIP(JJ+24),3)/B AAMA1962 + 3325 IF(JJ.GT.JD(10)) GO TO 3350 AAMA1963 + A2 = A2+COEDIP(JJ+27)*MATEL(N1,L1,N2,L2,J+4,EXPDIP(JJ+27),3)/B AAMA1964 + 3350 IF(JJ.GT.JD(11)) GO TO 3375 AAMA1965 + A3 = A3+COEDIP(JJ+30)*MATEL(N1,L1,N2,L2,J+5,EXPDIP(JJ+30),3)/B AAMA1966 + 3375 IF(JJ.GT.JD(12)) GO TO 3400 AAMA1967 + A3 = A3+COEDIP(JJ+33)*MATEL(N1,L1,N2,L2,J+6,EXPDIP(JJ+33),3)/B AAMA1968 + 3400 CONTINUE AAMA1969 + 3500 YF = YY*(3.0+YY)/(9.0+YY)**2 AAMA1970 + A(2) = COEDP(6)*POP(5)*EXTPY*(YF*P*AID*AMZZ(3)-A2)**2 AAMA1971 + YF = YY*YY/(9.0+YY)**2 $ YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA1972 + A(3) = COEDP(7)*POP(5)*EXTPY*YG*(YF*P*AID*AMZZ(3)-A3)**2 AAMA1973 + 3600 IF(M.NE.0.AND.M.NE.3) GO TO 3900 AAMA1974 + IF(F(8)+F(9).EQ.2) GO TO 3800 $ DO 3700 JJ=1,3 $ J = JK(JJ) AAMA1975 + B = Y**NE(JJ) $ IF(JJ.GT.JD(13)) GO TO 3650 AAMA1976 + A4 = A4+COEDIP(JJ+36)*MATEL(N1,L1,N2,L2,J+5,EXPDIP(JJ+36),3)/B AAMA1977 + 3650 IF(JJ.GT.JD(14)) GO TO 3700 AAMA1978 + A5 = A5+COEDIP(JJ+39)*MATEL(N1,L1,N2,L2,J+7,EXPDIP(JJ+39),3)/B AAMA1979 + 3700 CONTINUE AAMA1980 + 3800 YF = YY*YY/(9.0+YY)**2 $ YG = (1.0+YY)/YY AAMA1981 + A(4) = COEDP(8)*POP(6)*EXTPY*YG*(YF*P*AID*AMZZ(3)-A4)**2 AAMA1982 + YF = (YY/(9.0+YY))**3 $ YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA1983 + A(5) = COEDP(9)*POP(5)*EXTPY*YG*(YF*P*AID*AMZZ(3)-A5)**2 AAMA1984 + 3900 AT = A(1)+A(2)+A(3)+A(4)+A(5) $ RDIP = PICOEF*ANGD*AT $ RETURN AAMA1985 + END AAMA1986 +C-----------------------------------------------------------------------AAMA1987 + 0 FUNCTION RQUA(N1,L1,N2,L2,N,M,Y) $ DIMENSION A(6),JQ(15) AAMA1988 +C *** QUADRUPOLE PENETRATION ROUTINE AAMA1989 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA1990 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA1991 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC015/COEQUA(45),EXPQUA(45) AAMA1992 + COMMON/LOC019/F(10) $ COMMON/LOC021/ANGD,ANGQ,ANGO AAMA1993 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA1994 + COMMON/LOC024/COEQ(11) $ COMMON/LOC030/POP(6),DUM(24) AAMA1995 + COMMON/LOC031/JM(10),JD(14),KQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA1996 + INTEGER F $ REAL MATEL $ ETPY = EXP(2.000*PI*Y) AAMA1997 + EXTPY = ETPY/(ETPY-1.000) $ YY = Y*Y AAMA1998 + P = EXP(Y*(2.000*ATAN(Y/FLOAT(N))-PI)) $ DO 500 I=1,6 AAMA1999 + A(I)=0.000 AAMA2000 + 500 CONTINUE $ DO 550 JJ=1,15 $ JQ(JJ) = KQ(JJ) AAMA2001 + 550 CONTINUE $ IF(IJ(3).EQ.0) GO TO 900 $ DO 600 JJ=1,15 AAMA2002 + IF(Y.GT.YJ(3)) JQ(JJ) = MIN0(KQ(JJ),JJ1(3)) AAMA2003 + 600 CONTINUE AAMA2004 + 900 GO TO (1000,2000,3000),N AAMA2005 + 1000 A1 = 0.000 $ IF(F(1).EQ.1) GO TO 1200 $ DO 1100 JJ=1,3 AAMA2006 + IF(JJ.GT.JQ(1)) GO TO 1100 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA2007 + A1 = A1+COEQUA(JJ)*MATEL(N1,L1,N2,L2,J+4,EXPQUA(JJ),1)/B AAMA2008 + 1100 CONTINUE AAMA2009 + 1200 YF = YY/(4.0+YY) $ YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA2010 + PF = 9.0*P-1.000 AAMA2011 + RQUA = COEQ(2)*EXTPY*PICOEF*ANGQ*YG*(YF*PF*AIQ*AMZZ(1)**2-A1)**2AAMA2012 + RQUA = RQUA*POP(1) $ RETURN AAMA2013 + 2000 A1 =0.000 $ A2 = 0.000 $ A3 = 0.000 $ IF(M.EQ.2) GO TO 2300 AAMA2014 + IF(F(2).EQ.1) GO TO 2200 $ DO 2100 JJ=1,3 $ J = JK(JJ) AAMA2015 + B = Y**NE(JJ) $ IF(JJ.GT.JQ(2)) GO TO 2050 AAMA2016 + A1 = A1+COEQUA(JJ+3)*MATEL(N1,L1,N2,L2,J+4,EXPQUA(JJ+3),2)/B AAMA2017 + 2050 IF(JJ.GT.JQ(3)) GO TO 2100 AAMA2018 + A1 = A1+COEQUA(JJ+ 6)*MATEL(N1,L1,N2,L2,J+5,EXPQUA(JJ+ 6),2)/B AAMA2019 + 2100 CONTINUE AAMA2020 + 2200 YF = YY/(1.0+YY) $ YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA2021 + PF = 9.0*(4.0+5.0*YY)/(4.0+YY)*P-1.000 AAMA2022 + A(1) = COEQ(3)*POP(2)*EXTPY*YG*(YF*PF*AIQ*AMZZ(2)**2-A1)**2 AAMA2023 + 2300 IF(M.EQ.1) GO TO 2600 $ IF(F(3)+F(4).EQ.2) GO TO 2500 AAMA2024 + DO 2400 JJ=1,3 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA2025 + IF(JJ.GT.JQ(4)) GO TO 2350 AAMA2026 + A2 = A2+COEQUA(JJ+ 9)*MATEL(N1,L1,N2,L2,J+4,EXPQUA(JJ+ 9),2)/B AAMA2027 + 2350 IF(JJ.GT.JQ(5)) GO TO 2400 AAMA2028 + A3 = A3+COEQUA(JJ+12)*MATEL(N1,L1,N2,L2,J+6,EXPQUA(JJ+12),2)/B AAMA2029 + 2400 CONTINUE AAMA2030 + 2500 YF = YY/(1.0+YY) $ YG = (1.0+YY)/YY $ PF = 3.0*P+1.000 AAMA2031 + A(2) = COEQ(4)*POP(3)*EXTPY*YG*(YF*PF*AIQ*AMZZ(2)**2-A2)**2 AAMA2032 + YF = YY*YY/((1.0+YY)*(9.0+YY)) AAMA2033 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA2034 + PF = (68.0+77.0*YY)/(4.0+YY)*P-1.000 AAMA2035 + A(3) = COEQ(5)*POP(3)*EXTPY*YG*(YF*PF*AIQ*AMZZ(2)**2-A3)**2 AAMA2036 + 2600 AT = A(1)+A(2)+A(3) $ RQUA = PICOEF*ANGQ*AT $ RETURN AAMA2037 + 3000 A1 = 0.000 $ A2 = 0.000 $ A3 = 0.000 $ A4 = 0.000 $ A5 = 0.000 AAMA2038 + A6 = 0.000 $ IF(M.GT.1) GO TO 3300 $ IF(F(5).EQ.1) GO TO 3200 AAMA2039 + DO 3100 JJ=1,3 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA2040 + IF(JJ.GT.JQ(6)) GO TO 3030 AAMA2041 + A1 = A1+COEQUA(JJ+15)*MATEL(N1,L1,N2,L2,J+4,EXPQUA(JJ+15),3)/B AAMA2042 + 3030 IF(JJ.GT.JQ(7)) GO TO 3060 AAMA2043 + A1 = A1+COEQUA(JJ+18)*MATEL(N1,L1,N2,L2,J+5,EXPQUA(JJ+18),3)/B AAMA2044 + 3060 IF(JJ.GT.JQ(8)) GO TO 3100 AAMA2045 + A1 = A1+COEQUA(JJ+21)*MATEL(N1,L1,N2,L2,J+6,EXPQUA(JJ+21),3)/B AAMA2046 + 3100 CONTINUE AAMA2047 + 3200 YF = YY*(9.0+YY)/((1.0+YY)*(4.0+YY)) AAMA2048 + YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA2049 + PF = (729.0+1134.0*YY+277.0*YY*YY)/(9.0+YY)**2*P-1.000 AAMA2050 + A(1) = COEQ(6)*POP(4)*EXTPY*YG*(YF*PF*AIQ*AMZZ(3)**2-A1)**2 AAMA2051 + 3300 IF(M.NE.0.AND.M.NE.2) GO TO 3600 AAMA2052 + IF(F(6)+F(7).EQ.2) GO TO 3500 $ DO 3400 JJ=1,3 $ J = JK(JJ) AAMA2053 + B = Y**NE(JJ) $ IF(JJ.GT.JQ(9)) GO TO 3325 AAMA2054 + A2 = A2+COEQUA(JJ+24)*MATEL(N1,L1,N2,L2,J+4,EXPQUA(JJ+24),3)/B AAMA2055 + 3325 IF(JJ.GT.JQ(10)) GO TO 3350 AAMA2056 + A2 = A2+COEQUA(JJ+27)*MATEL(N1,L1,N2,L2,J+5,EXPQUA(JJ+27),3)/B AAMA2057 + 3350 IF(JJ.GT.JQ(11)) GO TO 3375 AAMA2058 + A3 = A3+COEQUA(JJ+30)*MATEL(N1,L1,N2,L2,J+6,EXPQUA(JJ+30),3)/B AAMA2059 + 3375 IF(JJ.GT.JQ(12)) GO TO 3400 AAMA2060 + A3 = A3+COEQUA(JJ+33)*MATEL(N1,L1,N2,L2,J+7,EXPQUA(JJ+33),3)/B AAMA2061 + 3400 CONTINUE AAMA2062 + 3500 YF = YY/(1.0+YY) $ YG = (1.0+YY)/YY AAMA2063 + PF = (27.0+11.0*YY)/(9.0+YY)*P+1.000 AAMA2064 + A(2) = COEQ(7)*POP(5)*EXTPY*YG*(YF*PF*AIQ*AMZZ(3)**2-A2)**2 AAMA2065 + YF = YY*YY/((1.0+YY)*(4.0+YY)) AAMA2066 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA2067 + PF = (1377.0+1944.0*YY+439.0*YY*YY)/(9.0+YY)**2*P-1.000 AAMA2068 + A(3) = COEQ(8)*POP(5)*EXTPY*YG*(YF*PF*AIQ*AMZZ(3)**2-A3)**2 AAMA2069 + 3600 IF(M.NE.0.AND.M.NE.3) GO TO 3900 AAMA2070 + IF(F(8)+F(9)+F(10).EQ.3) GO TO 3800 $ DO 3700 JJ=1,3 AAMA2071 + J = JK(JJ) $ B = Y**NE(JJ) $ IF(JJ.GT.JQ(13)) GO TO 3630 AAMA2072 + A4 = A4+COEQUA(JJ+36)*MATEL(N1,L1,N2,L2,J+4,EXPQUA(JJ+36),3)/B AAMA2073 + 3630 IF(JJ.GT.JQ(14)) GO TO 3660 AAMA2074 + A5 = A5+COEQUA(JJ+39)*MATEL(N1,L1,N2,L2,J+6,EXPQUA(JJ+39),3)/B AAMA2075 + 3660 IF(JJ.GT.JQ(15)) GO TO 3700 AAMA2076 + A6 = A6+COEQUA(JJ+42)*MATEL(N1,L1,N2,L2,J+8,EXPQUA(JJ+42),3)/B AAMA2077 + 3700 CONTINUE AAMA2078 + 3800 YF = YY/(9.0+YY) AAMA2079 + A(4) = COEQ(9)*POP(6)*EXTPY*(YF*P*AIQ*AMZZ(3)**2-A4)**2 AAMA2080 + YF = YY*YY/((1.0+YY)*(4.0+YY)) $ YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA2081 + PF = (63.0+47.0*YY)/(9.0+YY)*P+1.000 AAMA2082 + A(5) = COEQ(10)*POP(6)*EXTPY*YG*(YF*PF*AIQ*AMZZ(3)**2-A5)**2 AAMA2083 + YF = YY**3/((1.0+YY)*(4.0+YY)*(16.0+YY)) AAMA2084 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)*(16.0+YY)/YY**4 AAMA2085 + PF = (10773.0+14580.0*YY+3167.0*YY*YY)/(9.0+YY)**2*P-5.000 AAMA2086 + A(6) = COEQ(11)*POP(6)*EXTPY*YG*(YF*PF*AIQ*AMZZ(3)**2-A6)**2 AAMA2087 + 3900 AT = A(1)+A(2)+A(3)+A(4)+A(5)+A(6) $ RQUA = PICOEF*ANGQ*AT AAMA2088 + RETURN $ END AAMA2089 +C-----------------------------------------------------------------------AAMA2090 + 0 FUNCTION ROCT(N1,L1,N2,L2,N,M,Y) $ DIMENSION A(6),JO(15) AAMA2091 +C *** OCTUPOLE PENETRATION ROUTINE AAMA2092 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA2093 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA2094 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC016/COEOCT(45),EXPOCT(45) AAMA2095 + COMMON/LOC020/F(10) $ COMMON/LOC021/ANGD,ANGQ,ANGO AAMA2096 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA2097 + COMMON/LOC025/COEO(11) $ COMMON/LOC030/POP(6),DUM(24) AAMA2098 + COMMON/LOC031/JM(10),JD(14),JQ(15),KO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA2099 + INTEGER F $ REAL MATEL $ ETPY = EXP(2.000*PI*Y) AAMA2100 + EXTPY = ETPY/(ETPY-1.000) $ YY = Y*Y AAMA2101 + P = EXP(Y*(2.000*ATAN(Y/FLOAT(N))-PI)) $ DO 500 I=1,6 AAMA2102 + A(I)=0.000 AAMA2103 + 500 CONTINUE $ DO 550 JJ=1,15 $ JO(JJ) = KO(JJ) AAMA2104 + 550 CONTINUE $ IF(IJ(4).EQ.0) GO TO 900 $ DO 600 JJ=1,15 AAMA2105 + IF(Y.GT.YJ(4)) JO(JJ) = MIN0(KO(JJ),JJ1(4)) AAMA2106 + 600 CONTINUE AAMA2107 + 900 GO TO (1000,2000,3000),N AAMA2108 + 1000 A1 = 0.000 $ IF(F(1).EQ.1) GO TO 1200 $ DO 1100 JJ=1,3 AAMA2109 + IF(JJ.GT.JO(1)) GO TO 1100 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA2110 + A1 = A1+COEOCT(JJ)*MATEL(N1,L1,N2,L2,J+5,EXPOCT(JJ),1)/B AAMA2111 + 1100 CONTINUE AAMA2112 + 1200 YF = YY*(3.0+2.0*YY)/((4.0+YY)*(9.0+YY)) AAMA2113 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA2114 + PF = 15.0*(1.0+YY)/(3.0+2.0*YY)*P-1.000 AAMA2115 + ROCT = COEO(2)*PICOEF*ANGO*EXTPY*YG*(YF*PF*AIO*AMZZ(1)**3-A1)**2AAMA2116 + ROCT = ROCT*POP(1) $ RETURN AAMA2117 + 2000 A1 =0.000 $ A2 = 0.000 $ A3 = 0.000 $ IF(M.EQ.2) GO TO 2300 AAMA2118 + IF(F(2).EQ.1) GO TO 2200 $ DO 2100 JJ=1,3 $ J = JK(JJ) AAMA2119 + B = Y**NE(JJ) $ IF(JJ.GT.JO(2)) GO TO 2050 AAMA2120 + A1 = A1+COEOCT(JJ+3)*MATEL(N1,L1,N2,L2,J+5,EXPOCT(JJ+3),2)/B AAMA2121 + 2050 IF(JJ.GT.JO(3)) GO TO 2100 AAMA2122 + A1 = A1+COEOCT(JJ+ 6)*MATEL(N1,L1,N2,L2,J+6,EXPOCT(JJ+ 6),2)/B AAMA2123 + 2100 CONTINUE AAMA2124 + 2200 YF = YY*(6.0+YY)/((1.0+YY)*(9.0+YY)) AAMA2125 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA2126 + PF = 15.0*(2.0+3.0*YY)/(6.0+YY)*P-1.000 AAMA2127 + A(1) = COEO(3)*POP(2)*EXTPY*YG*(YF*PF*AIO*AMZZ(2)**3-A1)**2 AAMA2128 + 2300 IF(M.EQ.1) GO TO 2600 $ IF(F(3)+F(4).EQ.2) GO TO 2500 AAMA2129 + DO 2400 JJ=1,3 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA2130 + IF(JJ.GT.JO(4)) GO TO 2350 AAMA2131 + A2 = A2+COEOCT(JJ+ 9)*MATEL(N1,L1,N2,L2,J+5,EXPOCT(JJ+ 9),2)/B AAMA2132 + 2350 IF(JJ.GT.JO(5)) GO TO 2400 AAMA2133 + A3 = A3+COEOCT(JJ+12)*MATEL(N1,L1,N2,L2,J+7,EXPOCT(JJ+12),2)/B AAMA2134 + 2400 CONTINUE AAMA2135 + 2500 YF = YY/(1.0+YY) $ YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA2136 + PF = 3.0*P+1.000 AAMA2137 + A(2) = COEO(4)*POP(3)*EXTPY*YG*(YF*PF*AIO*AMZZ(2)**3-A2)**2 AAMA2138 + YF = YY*YY*(68.0+13.0*YY)/((1.0+YY)*(9.0+YY)*(16.0+YY)) AAMA2139 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)*(16.0+YY)/YY**4 AAMA2140 + PF = 5.0*(116.0+149.0*YY)/(68.0+13.0*YY)*P-1.000 AAMA2141 + A(3) = COEO(5)*POP(3)*EXTPY*YG*(YF*PF*AIO*AMZZ(2)**3-A3)**2 AAMA2142 + 2600 AT = A(1)+A(2)+A(3) $ ROCT = PICOEF*ANGO*AT $ RETURN AAMA2143 + 3000 A1 = 0.000 $ A2 = 0.000 $ A3 = 0.000 $ A4 = 0.000 $ A5 = 0.000 AAMA2144 + A6 = 0.000 $ IF(M.GT.1) GO TO 3300 $ IF(F(5).EQ.1) GO TO 3200 AAMA2145 + DO 3100 JJ=1,3 $ J = JK(JJ) $ B = Y**NE(JJ) AAMA2146 + IF(JJ.GT.JO(6)) GO TO 3030 AAMA2147 + A1 = A1+COEOCT(JJ+15)*MATEL(N1,L1,N2,L2,J+5,EXPOCT(JJ+15),3)/B AAMA2148 + 3030 IF(JJ.GT.JO(7)) GO TO 3060 AAMA2149 + A1 = A1+COEOCT(JJ+18)*MATEL(N1,L1,N2,L2,J+6,EXPOCT(JJ+18),3)/B AAMA2150 + 3060 IF(JJ.GT.JO(8)) GO TO 3100 AAMA2151 + A1 = A1+COEOCT(JJ+21)*MATEL(N1,L1,N2,L2,J+7,EXPOCT(JJ+21),3)/B AAMA2152 + 3100 CONTINUE AAMA2153 + 3200 YF = YY*(27.00+2.000*YY)/((1.0+YY)*(4.0+YY)) AAMA2154 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA2155 + PF = 2.5*(405.0+900.0*YY+254.0*YY*YY)/ AAMA2156 + 1 ((9.0+YY)*(27.00+2.000*YY))*P-1.000 AAMA2157 + A(1) = COEO(6)*POP(4)*EXTPY*YG*(YF*PF*AIO*AMZZ(3)**3-A1)**2 AAMA2158 + 3300 IF(M.NE.0.AND.M.NE.2) GO TO 3600 AAMA2159 + IF(F(6)+F(7).EQ.2) GO TO 3500 $ DO 3400 JJ=1,3 $ J = JK(JJ) AAMA2160 + B = Y**NE(JJ) $ IF(JJ.GT.JO(9)) GO TO 3325 AAMA2161 + A2 = A2+COEOCT(JJ+24)*MATEL(N1,L1,N2,L2,J+5,EXPOCT(JJ+24),3)/B AAMA2162 + 3325 IF(JJ.GT.JO(10)) GO TO 3350 AAMA2163 + A2 = A2+COEOCT(JJ+27)*MATEL(N1,L1,N2,L2,J+6,EXPOCT(JJ+27),3)/B AAMA2164 + 3350 IF(JJ.GT.JO(11)) GO TO 3375 AAMA2165 + A3 = A3+COEOCT(JJ+30)*MATEL(N1,L1,N2,L2,J+7,EXPOCT(JJ+30),3)/B AAMA2166 + 3375 IF(JJ.GT.JO(12)) GO TO 3400 AAMA2167 + A3 = A3+COEOCT(JJ+33)*MATEL(N1,L1,N2,L2,J+8,EXPOCT(JJ+33),3)/B AAMA2168 + 3400 CONTINUE AAMA2169 + 3500 YF = YY*(9.0+2.0*YY)/((1.0+YY)*(4.0+YY)) AAMA2170 + YG = (1.0+YY)*(4.0+YY)/(YY*YY) AAMA2171 + PF = (27.0+13.0*YY)/(9.0+2.0*YY)*P+1.000 AAMA2172 + A(2) = COEO(7)*POP(5)*EXTPY*YG*(YF*PF*AIO*AMZZ(3)**3-A2)**2 AAMA2173 + YF = YY*YY*(153.0+13.0*YY)/((1.0+YY)*(4.0+YY)*(16.0+YY)) AAMA2174 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)*(16.0+YY)/YY**4 AAMA2175 + PF = 5.0*(2349.0+3744.0*YY+947.0*YY*YY)/ AAMA2176 + 1 ((9.0+YY)*(153.0+13.0*YY))*P-1.000 AAMA2177 + A(3) = COEO(8)*POP(5)*EXTPY*YG*(YF*PF*AIO*AMZZ(3)**3-A3)**2 AAMA2178 + 3600 IF(M.NE.0.AND.M.NE.3) GO TO 3900 AAMA2179 + IF(F(8)+F(9)+F(10).EQ.3) GO TO 3800 $ DO 3700 JJ=1,3 AAMA2180 + J = JK(JJ) $ B = Y**NE(JJ) $ IF(JJ.GT.JO(13)) GO TO 3630 AAMA2181 + A4 = A4+COEOCT(JJ+36)*MATEL(N1,L1,N2,L2,J+5,EXPOCT(JJ+36),3)/B AAMA2182 + 3630 IF(JJ.GT.JO(14)) GO TO 3660 AAMA2183 + A5 = A5+COEOCT(JJ+39)*MATEL(N1,L1,N2,L2,J+7,EXPOCT(JJ+39),3)/B AAMA2184 + 3660 IF(JJ.GT.JO(15)) GO TO 3700 AAMA2185 + A6 = A6+COEOCT(JJ+42)*MATEL(N1,L1,N2,L2,J+9,EXPOCT(JJ+42),3)/B AAMA2186 + 3700 CONTINUE AAMA2187 + 3800 YF = YY/(1.0+YY) $ YG = (1.0+YY)/YY $ PF = 2.0*P+1.000 AAMA2188 + A(4) = COEO(9)*POP(6)*EXTPY*YG*(YF*PF*AIO*AMZZ(3)**3-A4)**2 AAMA2189 + YF = YY*YY/((1.0+YY)*(4.0+YY)) AAMA2190 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)/YY**3 AAMA2191 + PF = (63.0+47.0*YY)/(9.0+YY)*P+1.000 AAMA2192 + A(5) = COEO(10)*POP(6)*EXTPY*YG*(YF*PF*AIO*AMZZ(3)**3-A5)**2 AAMA2193 + YF = YY**3*(11.0+YY)/((1.0+YY)*(4.0+YY)*(16.0+YY)*(25.0+YY)) AAMA2194 + YG = (1.0+YY)*(4.0+YY)*(9.0+YY)*(16.0+YY)*(25.0+YY)/YY**5 AAMA2195 + PF = (1251.0+1850.0*YY+439.0*YY*YY)/((9.0+YY)*(11.0+YY))*P-1.000AAMA2196 + A(6) = COEO(11)*POP(6)*EXTPY*YG*(YF*PF*AIO*AMZZ(3)**3-A6)**2 AAMA2197 + 3900 AT = A(1)+A(2)+A(3)+A(4)+A(5)+A(6) $ ROCT = PICOEF*ANGO*AT AAMA2198 + RETURN $ END AAMA2199 +C-----------------------------------------------------------------------AAMA2200 + 0 FUNCTION RDIPU(N1,L1,N2,L2,N,ENEM,Y,MM) AAMA2201 +C *** DIPOLE UNPENETRATED RATES ROUTINE AAMA2202 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA2203 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA2204 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC026/COED(4) AAMA2205 + COMMON/LOC021/ANGD,ANGQ,ANGO AAMA2206 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA2207 + COMMON/LOC030/POP(6),D(24) $ REAL MATELU $ IF(N.GT.0) GO TO 1000AAMA2208 + AID = MATELU(N1,L1,N2,L2,1) $ AIDSQ = AID*AID $ L = (L1+L2+1)/2 AAMA2209 + ANGD = FLOAT((2*L2+1)*L)/FLOAT((2*L-1)*(2*L+1)) AAMA2210 + RDIPU = COED(1)*COEFF/(Z*Z*AMASSM*AMASSM)*(ENEM/ALFA)**3 AAMA2211 + 1 *ANGD*AIDSQ $ RETURN AAMA2212 + 1000 EPIY = EXP(PI*Y) $ EXPIY = 1.000/(EPIY-1.000/EPIY) $ YY = Y*Y AAMA2213 + P2 = EXP(Y*(4.000*ATAN(Y/FLOAT(N))-PI)) $ M = MM+1 AAMA2214 + GO TO (2000,3000,4000),N AAMA2215 + 2000 YF = YY/(1.000+YY) AAMA2216 + RDIPU = COED(2)*POP(1)*PICOEF*ANGD*P2*EXPIY*YF*AIDSQ*AMZZ(1)**2 AAMA2217 + RETURN AAMA2218 + 3000 GO TO (3100,3200,3300),M AAMA2219 + 3100 YF = YY*(4.0+3.0*YY)*(4.0+5.0*YY)/(4.0+YY)**3*(POP(2)+3.000* AAMA2220 + 1 POP(3))/4.000 $ GO TO 3400 AAMA2221 + 3200 YF = 4.000*YY*(1.0+YY)/(4.0+YY)**2*POP(2) $ GO TO 3400 AAMA2222 + 3300 YF = YY*YY*(12.0+11.0*YY)/(4.0+YY)**3*POP(3) AAMA2223 + 3400 RDIPU = COED(3)*PICOEF*ANGD*P2*EXPIY*YF*AIDSQ*AMZZ(2)**2 AAMA2224 + RETURN AAMA2225 + 4000 GO TO (4100,4200,4300,4400),M AAMA2226 + 4100 YF = YY*(81.0+78.0*YY+13.0*YY*YY)*(81.0+126.0*YY+29.0*YY*YY) AAMA2227 + 1 /(9.0+YY)**5*(POP(4)+3.000*POP(5)+5.000*POP(6))/9.000 AAMA2228 + GO TO 4500 AAMA2229 + 4200 YF = YY*(1.0+YY)*(27.0+7.0*YY)**2/(9.0+YY)**4*POP(4) AAMA2230 + GO TO 4500 AAMA2231 + 4300 YF = 8.000*YY*YY*(81.0+96.0*YY+19.0*YY*YY)/(9.0+YY)**4*POP(5) AAMA2232 + GO TO 4500 AAMA2233 + 4400 YF = 16.000*YY**3*(45.0+11.0*YY)*(1.0+YY)/(9.0+YY)**5*POP(6) AAMA2234 + 4500 RDIPU = COED(4)*PICOEF*ANGD*P2*EXPIY*YF*AIDSQ*AMZZ(3)**2 AAMA2235 + RETURN $ END AAMA2236 +C-----------------------------------------------------------------------AAMA2237 + 0 FUNCTION RQUAU(N1,L1,N2,L2,N,ENEM,Y,M) $ DIMENSION A(6) AAMA2238 +C *** QUADRUPOLE UNPENETRATES RATES ROUTINE AAMA2239 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA2240 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA2241 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC024/COEQ(11) AAMA2242 + COMMON/LOC021/ANGD,ANGQ,ANGO AAMA2243 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA2244 + COMMON/LOC030/POP(6),D(24) $ REAL MATELU $ IF(N.GT.0) GO TO 1000AAMA2245 + AIQ = MATELU(N1,L1,N2,L2,2) $ AIQSQ = AIQ*AIQ $ L = (L1+L2)/2 AAMA2246 + ANGQ=1.500 $ IF(L2.EQ.L1) ANGQ=1.000 AAMA2247 + ANGQ = ANGQ*FLOAT((2*L2+1)*L*(L+1))/ AAMA2248 + 1 FLOAT((2*L-1)*(2*L+1)*(2*L+3)) AAMA2249 + RQUAU = COEQ(1)*COEFF/(Z*AMASSM)**4*(ENEM/ALFA)**5*ANGQ*AIQSQ AAMA2250 + RETURN AAMA2251 + 1000 ETPY = EXP(2.000*PI*Y) $ EXTPY = ETPY/(ETPY-1.000) $ YY = Y*Y AAMA2252 + P = EXP(Y*(2.000*ATAN(Y/FLOAT(N))-PI)) $ DO 1100 I=1,6 AAMA2253 + A(I)=0.000 AAMA2254 + 1100 CONTINUE $ GO TO (2000,3000,4000),N AAMA2255 + 2000 YF = (1.0+YY)/(4.0+YY) $ PF = (9.0*P-1.0)**2 AAMA2256 + RQUAU = COEQ(2)*POP(1)*PICOEF*ANGQ*PF*EXTPY*YF*AIQSQ*AMZZ(1)**4 AAMA2257 + RETURN AAMA2258 + 3000 IF(M.EQ.2) GO TO 3100 $ YF = (4.0+YY)/(1.0+YY) AAMA2259 + PF = (9.0*(4.0+5.0*YY)/(4.0+YY)*P-1.000)**2 AAMA2260 + A(1) = COEQ(3)*POP(2)*YF*PF AAMA2261 + 3100 IF(M.EQ.1) GO TO 3200 $ YF = YY/(1.0+YY) AAMA2262 + PF = (3.0*P+1.000)**2 $ A(2) = COEQ(4)*POP(3)*YF*PF AAMA2263 + YF = YY*(4.0+YY)/((1.0+YY)*(9.0+YY)) AAMA2264 + PF = ((68.0+77.0*YY)/(4.0+YY)*P-1.000)**2 AAMA2265 + A(3) = COEQ(5)*POP(3)*YF*PF AAMA2266 + 3200 AT = A(1)+A(2)+A(3) AAMA2267 + RQUAU = PICOEF*ANGQ*AT*EXTPY*AIQSQ*AMZZ(2)**4 $ RETURN AAMA2268 + 4000 IF(M.GT.1) GO TO 4100 $ YF = (9.0+YY)**2/((1.0+YY)*(4.0+YY)) AAMA2269 + PF = ((729.0+1134.0*YY+277.0*YY*YY)/(9.0+YY)**2*P-1.000)**2 AAMA2270 + A(1) = COEQ(6)*POP(4)*YF*PF AAMA2271 + 4100 IF(M.NE.0.AND.M.NE.2) GO TO 4200 $ YF = YY/(1.0+YY) AAMA2272 + PF = ((27.0+11.0*YY)/(9.0+YY)*P+1.000)**2 AAMA2273 + A(2) = COEQ(7)*POP(5)*YF*PF AAMA2274 + YF = YY*(9.0+YY)/((1.0+YY)*(4.0+YY)) AAMA2275 + PF = ((1377.0+1944.0*YY+439.0*YY*YY)/(9.0+YY)**2*P-1.000)**2 AAMA2276 + A(3) = COEQ(8)*POP(5)*YF*PF AAMA2277 + 4200 IF(M.NE.0.AND.M.NE.3) GO TO 4300 $ YF = YY*YY/(9.0+YY)**2 AAMA2278 + PF = P**2 $ A(4) = COEQ(9)*POP(6)*YF*PF AAMA2279 + YF = YY*YY/((1.0+YY)*(4.0+YY)) AAMA2280 + PF = ((63.0+47.0*YY)/(9.0+YY)*P+1.000)**2 AAMA2281 + A(5) = COEQ(10)*POP(6)*YF*PF AAMA2282 + YF = YY*YY*(9.0+YY)/((1.0+YY)*(4.0+YY)*(16.0+YY)) AAMA2283 + PF = ((10773.0+14580.0*YY+3167.0*YY*YY)/(9.0+YY)**2*P-5.000)**2 AAMA2284 + A(6) = COEQ(11)*POP(6)*YF*PF AAMA2285 + 4300 AT = A(1)+A(2)+A(3)+A(4)+A(5)+A(6) AAMA2286 + RQUAU = PICOEF*ANGQ*AT*EXTPY*AIQSQ*AMZZ(3)**4 $ RETURN $ END AAMA2287 +C-----------------------------------------------------------------------AAMA2288 + 0 FUNCTION ROCTU(N1,L1,N2,L2,N,ENEM,Y,M) $ DIMENSION A(6) AAMA2289 +C *** OCTUPOLE UNPENETRATED RATES ROUTINE AAMA2290 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA2291 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA2292 + COMMON/LOC012/AMZZ(3) $ COMMON/LOC025/COEO(11) AAMA2293 + COMMON/LOC021/ANGD,ANGQ,ANGO AAMA2294 + COMMON/LOC022/AID,AIQ,AIO,AIDSQ,AIQSQ,AIOSQ AAMA2295 + COMMON/LOC030/POP(6),D(24) $ REAL MATELU $ IF(N.GT.0) GO TO 1000AAMA2296 + AIO = MATELU(N1,L1,N2,L2,3) $ AIOSQ = AIO*AIO $ L = (L1+L2+1)/2 AAMA2297 + ANGO = 2.500 $ IF(IABS(L1-L2).EQ.1) ANGO = 1.500 AAMA2298 + ANGO = ANGO*FLOAT((2*L2+1)*(L-1)*L*(L+1))/ AAMA2299 + 1 FLOAT((2*L-3)*(2*L-1)*(2*L+1)*(2*L+3)) AAMA2300 + ROCTU = COEO(1)*COEFF/(Z*AMASSM)**6*(ENEM/ALFA)**7*ANGO*AIOSQ AAMA2301 + RETURN AAMA2302 + 1000 ETPY = EXP(2.000*PI*Y) $ EXTPY = ETPY/(ETPY-1.000) $ YY = Y*Y AAMA2303 + P = EXP(Y*(2.000*ATAN(Y/FLOAT(N))-PI)) $ DO 1100 I=1,6 AAMA2304 + A(I) = 0.000 AAMA2305 + 1100 CONTINUE $ GO TO (2000,3000,4000),N AAMA2306 + 2000 YF = (1.0+YY)*(3.0+2.0*YY)**2/(YY*(4.0+YY)*(9.0+YY)) AAMA2307 + PF = (15.0*(1.0+YY)/(3.0+2.0*YY)*P-1.000)**2 AAMA2308 + ROCTU = COEO(2)*POP(1)*PICOEF*ANGO*PF*EXTPY*YF*AIOSQ*AMZZ(1)**6 AAMA2309 + RETURN AAMA2310 + 3000 IF(M.EQ.2) GO TO 3100 AAMA2311 + YF = (4.0+YY)*(6.0+YY)**2/(YY*(1.0+YY)*(9.0+YY)) AAMA2312 + PF = (15.0*(2.0+3.0*YY)/(6.0+YY)*P-1.000)**2 AAMA2313 + A(1) = COEO(3)*POP(2)*YF*PF AAMA2314 + 3100 IF(M.EQ.1) GO TO 3200 $ YF = (4.0+YY)/(1.0+YY) AAMA2315 + PF = (3.0*P+1.000)**2 $ A(2) = COEO(4)*POP(3)*YF*PF AAMA2316 + YF = (4.0+YY)*(68.0+13.0*YY)**2/((1.0+YY)*(9.0+YY)*(16.0+YY)) AAMA2317 + PF = (5.0*(116.0+149.0*YY)/(68.0+13.0*YY)*P-1.000)**2 AAMA2318 + A(3) = COEO(5)*POP(3)*YF*PF AAMA2319 + 3200 AT = A(1)+A(2)+A(3) AAMA2320 + ROCTU = PICOEF*ANGO*AT*EXTPY*AIOSQ*AMZZ(2)**6 $ RETURN AAMA2321 + 4000 IF(M.GT.1) GO TO 4100 AAMA2322 + YF = (9.0+YY)*(27.00+2.000*YY)**2/(YY*(1.0+YY)*(4.0+YY)) AAMA2323 + PF = (2.5*(405.0+900.0*YY+254.0*YY*YY)/ AAMA2324 + 1 ((9.0+YY)*(27.00+2.000*YY))*P-1.000)**2 AAMA2325 + A(1) = COEO(6)*POP(4)*YF*PF AAMA2326 + 4100 IF(M.NE.0.AND.M.NE.2) GO TO 4200 AAMA2327 + YF = (9.0+2.0*YY)**2/((1.0+YY)*(4.0+YY)) AAMA2328 + PF = ((27.0+13.0*YY)/(9.0+2.0*YY)*P+1.000)**2 AAMA2329 + A(2) = COEO(7)*POP(5)*YF*PF AAMA2330 + YF = (9.0+YY)*(153.0+13.0*YY)**2/((1.0+YY)*(4.0+YY)*(16.0+YY)) AAMA2331 + PF = (5.0*(2349.0+3744.0*YY+947.0*YY*YY)/ AAMA2332 + 1 ((9.0+YY)*(153.0+13.0*YY))*P-1.000)**2 AAMA2333 + A(3) = COEO(8)*POP(5)*YF*PF AAMA2334 + 4200 IF(M.NE.0.AND.M.NE.3) GO TO 4300 $ YF = YY/(1.0+YY) AAMA2335 + PF = (2.0*P+1.000)**2 $ A(4) = COEO(9)*POP(6)*YF*PF AAMA2336 + YF = YY*(9.0+YY)/((1.0+YY)*(4.0+YY)) AAMA2337 + PF = ((63.0+47.0*YY)/(9.0+YY)*P+1.000)**2 AAMA2338 + A(5) =COEO(10)*POP(6)*YF*PF $ YF = YY*(9.0+YY)*(11.0+YY)**2/ AAMA2339 + 1 ((1.0+YY)*(4.0+YY)*(16.0+YY)*(25.0+YY)) AAMA2340 + PF = ((1251.0+1850.0*YY+439.0*YY*YY)/ AAMA2341 + 1 ((9.0+YY)*(11.0+YY))*P-1.0000)**2 $ A(6) = COEO(11)*POP(6)*YF*PFAAMA2342 + 4300 AT = A(1)+A(2)+A(3)+A(4)+A(5)+A(6) AAMA2343 + ROCTU = PICOEF*ANGO*AT*EXTPY*AIOSQ*AMZZ(3)**6 $ RETURN $ END AAMA2344 +C-----------------------------------------------------------------------AAMA2345 + 0 SUBROUTINE POPJ(L1,L2,LL,P) $ DIMENSION P(4) $ LI=LL+1 AAMA2346 +C *** FINDS RELATIVE POPULATION OF ALL POSSIBLE J-STATES AAMA2347 + L = MAX0(L1,L2) $ P(3) = 0.000 $ P(4) = 0.000 AAMA2348 + GO TO (1000,2000,3000,4000),LI AAMA2349 + 1000 P(1) = FLOAT(L+1)/FLOAT(2*L+1) $ P(2) = 1.000-P(1) $ RETURN AAMA2350 + 2000 P(1) = FLOAT((L+1)*(2*L-1))/FLOAT(4*L*L-1) AAMA2351 + P(2) = 1.000/FLOAT(4*L*L-1) $ P(3) = 1.000-(P(1)+P(2)) $ RETURN AAMA2352 + 3000 IF(L1.EQ.L2) GO TO 3500 $ P(1) = FLOAT(L+1)/FLOAT(2*L+1) AAMA2353 + P(2) = 2.000/FLOAT((2*L-3)*(2*L+1)) $ P(3) = 1.000-(P(1)+P(2)) AAMA2354 + RETURN AAMA2355 + 3500 D = FLOAT((2*L+1)**2) $ P(1) = FLOAT((L+2)*(2*L-1))/D AAMA2356 + P(2) = FLOAT((L-1)*(2*L+3))/D $ P(3) = 3.000/D $ P(4) = P(3) AAMA2357 + RETURN AAMA2358 + 4000 IF(IABS(L1-L2).EQ.1) GO TO 4500 AAMA2359 + P(1) = FLOAT(L+1)/FLOAT(2*L+1) AAMA2360 + P(2) = 3.000/FLOAT((2*L-5)*(2*L+1)) $ P(3) = 1.000-(P(1)+P(2)) AAMA2361 + RETURN AAMA2362 + 4500 D = FLOAT(4*L*L-1) $ P(1) = FLOAT((2*L-3)*(L+2))/D AAMA2363 + P(2) = 5.000/D $ P(3) = 6.000/D $ P(4) = 1.000-(P(1)+P(2)+P(3)) AAMA2364 + RETURN $ END AAMA2365 +C-----------------------------------------------------------------------AAMA2366 + 0 SUBROUTINE CHECK(N) $ DIMENSION AA(3,20) $ COMMON/LOC007/IC AAMA2367 +C *** NUMERICAL ACCURACY CONTROL -- COMPUTES DIAGONAL M.E. AAMA2368 + COMMON/LOC008/IR,IW,IP,IPRINT $ COMMON/LOC027/LL(20) AAMA2369 + REAL MATELU $ IF(IC.LE.0) RETURN $ GO TO (1000,2000,3000),IC AAMA2370 + 1000 A = (MATELU(N,0,N,0,1)/RAV(N,0,1))**2 $ WRITE(IW,1100)N,A AAMA2371 + 1100 FORMAT(/29H *** ACCURACY CONTROL AT N = ,I2,8H, DIP = , AAMA2372 + 1 F13.9,22H (SHOULD BE UNITY) ***) AAMA2373 + 0 RETURN AAMA2374 + 2000 A = (MATELU(N,0,N,0,1)/RAV(N,0,1))**2 AAMA2375 + B = (MATELU(N,0,N,0,2)/RAV(N,0,2))**2 AAMA2376 + C = (MATELU(N,0,N,0,3)/RAV(N,0,3))**2 $ WRITE(IW,2100)N,A,B,C AAMA2377 + 2100 FORMAT(/29H *** ACCURACY CONTROL AT N = ,I2,8H, DIP = ,F13.9, AAMA2378 + 1 8H, QUA = ,F13.9,8H, OCT = ,F13.9,22H (SHOULD BE UNITY) ***) AAMA2379 + 0 RETURN AAMA2380 + 3000 DO 3100 I = 1,3 $ DO 3100 J = 1,N $ I1 = I $ J1 = J-1 AAMA2381 + AA(I,J) = (MATELU(N,J1,N,J1,I1)/RAV(N,J1,I1))**2 AAMA2382 + 3100 CONTINUE $ WRITE(IW,3200)N,(LL(J),(AA(I,J),I=1,3),J=1,N) AAMA2383 + 3200 FORMAT(/29H *** ACCURACY CONTROL AT N = ,I2,16H (SHOULD BE UNIT AAMA2384 + 1 ,6HY) ***/41H L DIPOLES QUADRUPOLES OCTUPOLES/ AAMA2385 + 2 (1X,I2,3F13.9)) AAMA2386 + 0 RETURN $ END AAMA2387 +C-----------------------------------------------------------------------AAMA2388 + 0 REAL FUNCTION MATEL(N1,L1,N2,L2,L,A,N) AAMA2389 +C *** GENERAL DIMENSIONLESS MUONIC MATRIX ELEMENT FOR PENETRATION AAMA2390 + DOUBLE PRECISION F,P,A1,A2,S1,S2 $ COMMON/LOC012/AMZZ(3) AAMA2391 + COMMON/LOC009/F(60),FD $ AN = FLOAT(N1+N2) AAMA2392 + P = 1.000D00 + DBLE(1.000E-03*A*FLOAT(N1*N2)/AN) AAMA2393 + A1 = -2.000D00*DBLE(FLOAT(N2)/AN)/P AAMA2394 + A2 = -2.000D00*DBLE(FLOAT(N1)/AN)/P $ M1 = N1-L1 $ M2 = N2-L2 AAMA2395 + M3 = N1+L1+1 $ M4 = N2+L2+1 $ M5 = 2*L1+2 $ M6 = 2*L2+2 AAMA2396 + MM = L1+L2+L+3 $ S1 = 0.000D00 $ DO 200 I1 = 1,M1 $ K1 = I1-1 AAMA2397 + S2 = 0.000D00 $ DO 100 I2 = 1,M2 $ K2 = I2-1 $ LA = MM+K1+K2 AAMA2398 + LB = M2-K2 $ LC = M6+K2 AAMA2399 + S2 = S2 + A2**K2*F(LA)/(F(LB)*F(LC)*F(I2)) AAMA2400 + 100 CONTINUE $ LD = M1-K1 $ LE = M5+K1 AAMA2401 + S1 = S1 + S2*A1**K1/(F(LD)*F(LE)*F(I1)) AAMA2402 + 200 CONTINUE $ AQ = 2.000/(AN*SNGL(P)) AAMA2403 + T1 = SNGL(S1*DSQRT(F(M1)*F(M2)/DBLE(AQ**(L-1))*F(M3)*F(M4))) AAMA2404 + MATEL = T1*(AQ*FLOAT(N1))**(L+L2+1)*(AQ*FLOAT(N2))**(L+L1+1) AAMA2405 + 1 *0.500**(L+1)*FD**(L+1)/SQRT(AQ**(L-1))*(AMZZ(N))**L AAMA2406 + RETURN $ END AAMA2407 +C-----------------------------------------------------------------------AAMA2408 + 0 REAL FUNCTION MATELU(N1,L1,N2,L2,L) AAMA2409 +C *** GENERAL DIMENSIONLESS MUONIC MATRIX ELEMENT FOR NONPENETRATION AAMA2410 + DOUBLE PRECISION F,A1,A2,S1,S2 $ COMMON/LOC009/F(60),FD AAMA2411 + AN = FLOAT(N1+N2) $ A1 = -2.000D00*DBLE(FLOAT(N2)/AN) AAMA2412 + A2 = -2.000D00*DBLE(FLOAT(N1)/AN) $ M1 = N1-L1 $ M2 = N2-L2 AAMA2413 + M3 = N1+L1+1 $ M4 = N2+L2+1 $ M5 = 2*L1+2 $ M6 = 2*L2+2 AAMA2414 + MM = L1+L2+L+3 $ S1 = 0.000D00 $ DO 200 I1 = 1,M1 $ K1 = I1-1 AAMA2415 + S2 = 0.000D00 $ DO 100 I2 = 1,M2 $ K2 = I2-1 $ LA = MM+K1+K2 AAMA2416 + LB = M2-K2 $ LC = M6+K2 AAMA2417 + S2 = S2 + A2**K2*F(LA)/(F(LB)*F(LC)*F(I2)) AAMA2418 + 100 CONTINUE $ LD = M1-K1 $ LE = M5+K1 AAMA2419 + S1 = S1 + S2*A1**K1/(F(LD)*F(LE)*F(I1)) AAMA2420 + 200 CONTINUE $ AQ = 2.000/AN AAMA2421 + T1 = SNGL(S1*DSQRT(F(M1)*F(M2)/DBLE(AQ**(L-1))*F(M3)*F(M4))) AAMA2422 + MATELU = T1*(AQ*FLOAT(N1))**(L+L2+1)*(AQ*FLOAT(N2))**(L+L1+1) AAMA2423 + 1 *0.500**(L+1)*FD**(L+1)/SQRT(AQ**(L-1)) $ RETURN $ END AAMA2424 +C-----------------------------------------------------------------------AAMA2425 + 0 FUNCTION BETA(L1,J1,L2,J2,L) $ A1 = 0.250*FLOAT(J1*(J1+2)) AAMA2426 +C *** DEPOLARIZATION FACTOR AAMA2427 + A2 = 0.250*FLOAT(J2*(J2+2)) AAMA2428 + BETA = (A2-FLOAT(L2*(L2+1))+0.750)/(A1-FLOAT(L1*(L1+1))+0.750) AAMA2429 + 1 *(A1+A2-FLOAT(L*(L+1)))/(2.000*A2) $ RETURN $ END AAMA2430 +C-----------------------------------------------------------------------AAMA2431 + 0 FUNCTION POINT(N,J) $ DOUBLE PRECISION DN,DZA,DZA2,D,DJ,DREDM AAMA2432 +C *** POINT-LIKE DIRAC ENERGY FUNCTION AAMA2433 + COMMON/LOC034/DZA,DZA2,DREDM $ DN = DBLE(FLOAT(N)) AAMA2434 + DJ = DBLE(FLOAT(J)) $ D = DZA/(DN-DJ+DSQRT(DJ*DJ-DZA2)) AAMA2435 + D = DREDM/DSQRT(1.000D00+D*D) $ POINT = SNGL(DREDM-D) $ RETURN AAMA2436 + END AAMA2437 +C-----------------------------------------------------------------------AAMA2438 + 0 FUNCTION ID(A) $ INTEGER A,B $ DIMENSION B(10) AAMA2439 +C *** USED IN DECYPHERING TO CONVERT CHARACTERS INTO NUMBERS AAMA2440 + DATA B/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/ $ ID = 0 AAMA2441 + DO 100 J=1,10 $ IF(A.EQ.B(J)) ID=J-1 AAMA2442 + 100 CONTINUE $ RETURN $ END AAMA2443 +C-----------------------------------------------------------------------AAMA2444 + 0 FUNCTION RAV(N,L,M) $ GO TO (100,200,300),M AAMA2445 +C *** USED BY CHECK TO FIND THE EXACT EXPECTATION VALUES AAMA2446 + 100 RAV = 0.500*FLOAT(3*N*N-L*(L+1)) $ RETURN AAMA2447 + 200 RAV = 0.500*FLOAT(N*N*(5*N*N+1-3*L*(L+1))) $ RETURN AAMA2448 + 300 RAV = 0.125*FLOAT(N*N*(35*N*N*(N*N-1)-30*N*N*(L+2)*(L-1)+ AAMA2449 + 1 3*(L+2)*(L+1)*L*(L-1))) $ RETURN $ END AAMA2450 +C-----------------------------------------------------------------------AAMA2451 + 0 BLOCK DATA $ DOUBLE PRECISION F AAMA2452 +C *** BLOCK DATA WITH ALL INTRINSIC PARAMETERS AND DEFAULT VALUES AAMA2453 + COMMON/LOC001/IJK,ENERGY,ECONS,ECONST,D2P1SM,D2P1S AAMA2454 + COMMON/LOC002/BEM(3),ZSA(3),BE(3) $ COMMON/LOC003/K0,K1,K2,K3 AAMA2455 + COMMON/LOC004/NN0(3),NN1(7),NN2(7),NN3(7) AAMA2456 + COMMON/LOC006/IP1(7),IP2(7),IP3(7),IQ1(7),IQ2(7),IQ3(7) AAMA2457 + COMMON/LOC007/IC $ COMMON/LOC008/IREAD,IW,IPUNCH,IPRINT AAMA2458 + COMMON/LOC009/F(60),FD AAMA2459 + COMMON/LOC010/PI,PICOEF,AMASSM,NE(3),JK(3),COEFF,ALFA,AMASSE AAMA2460 + COMMON/LOC011/Z,ZSK,ZSL,ZSM,ZSKZ,ZSLZ,ZSMZ AAMA2461 + COMMON/LOC013/COEMON(30),EXPMON(30) AAMA2462 + COMMON/LOC014/COEDIP(42),EXPDIP(42) AAMA2463 + COMMON/LOC015/COEQUA(45),EXPQUA(45) AAMA2464 + COMMON/LOC016/COEOCT(45),EXPOCT(45) $ COMMON/LOC017/IFM(6) AAMA2465 + COMMON/LOC018/IFD(9) $ COMMON/LOC019/IFQ(10) AAMA2466 + COMMON/LOC020/IFO(10) $ COMMON/LOC023/COEDP(9) AAMA2467 + COMMON/LOC024/COEQ(11) $ COMMON/LOC025/COEO(11) AAMA2468 + COMMON/LOC026/COED(4) $ COMMON/LOC027/LL(20) AAMA2469 + COMMON/LOC028/M1(7),M2(7),M3(7),YC(4),IDB AAMA2470 + COMMON/LOC030/POP(6),JTM(6),JTD(6),JTQ(6),JTO(6) AAMA2471 + COMMON/LOC031/JM(10),JD(14),JQ(15),JO(15),IYC,IJ(4),YJ(4),JJ1(4)AAMA2472 + COMMON/LOC032/EHIGH,ELOW,CLIMIT,ERES,ESP,ESPM AAMA2473 + COMMON/LOC035/ICC,CD(5),EA,EB,IDIR AAMA2474 + COMMON/LOC036/ZMK,ZML,ZMM,ZMKM,ZMLM,ZMMM,IVERS AAMA2475 + COMMON/LOC037/PL(20),NPOL(20),IPOL,CL1,CL2,IDE,PLN(210),IP8 AAMA2476 + COMMON/LOC038/A,CFM,TFM,STEP,RMATCH,WIDTHK,IPC(3) AAMA2477 + COMMON/LOC039/NOPT,NMAX,ALEXP $ COMMON/LOC040/AMASSA,AMASSN,HBARAAMA2478 + COMMON/LOC041/MPU,ICPU(200),IPN AAMA2479 + DATA IJK,ENERGY,ECONS,D2P1S/0,1.0E4,5.505355E-03,0.000E+00/ AAMA2480 + DATA BE/3*0.000/ $ DATA K0,K1,K2,K3/3, 4,4,4/ $ DATA NN0/1,2,3/ AAMA2481 + DATA NN1/0,1,2,3,3,3,3/ $ DATA M1/0,0,0,0,1,2,3/ AAMA2482 + DATA NN2/0,1,2,3,3,3,3/ $ DATA M2/0,0,0,0,1,2,3/ AAMA2483 + DATA NN3/0,1,2,3,3,3,3/ $ DATA M3/0,0,0,0,1,2,3/ AAMA2484 + DATA IP1/0,1,1,1,1,1,1/ $ DATA IP2/0,1,1,1,1,1,1/ AAMA2485 + DATA IP3/0,1,1,1,1,1,1/ $ DATA IQ1/0,0,0,0,0,0,0/ AAMA2486 + DATA IQ2/0,0,0,0,0,0,0/ $ DATA IQ3/0,0,0,0,0,0,0/ AAMA2487 + DATA IDB,YC/0,1.000,1.000,1.000,1.000/ $ DATA PLN/210*0.000/ AAMA2488 + DATA IC,IREAD,IW,IPUNCH,FD,IPRINT,IPOL/3,5,6,7,15.000,0,0/ AAMA2489 + DATA PI,PICOEF,AMASSM/3.1415926535,1.298778E17,206.7686/ AAMA2490 + DATA COEFF,ALFA,AMASSE/4.134139E16,7.297353E-03,511003.4/ AAMA2491 + DATA NE,JK/0,2,2,0,2,3/ $ DATA Z,ZSK,ZSL,ZSM/4*0.000/ AAMA2492 + DATA IFM/6*0/ $ DATA IFD/9*0/ $ DATA IFQ/10*0/ $ DATA IFO/10*0/ AAMA2493 + DATA CL1,CL2/0.00,0.000/ $ DATA JTM,JTD,JTQ,JTO/6*1,6*1,6*1,6*1/AAMA2494 + DATA COEDP/2.133333E+01,4.266667E+01,3.555556E+00,1.137778E+02, AAMA2495 + 1 7.111111E+00,5.688889E+01,1.02400E+03,2.275556E+01,1.228800E+03/AAMA2496 + DATA COEQ/6.666667E-02,8.888889E-02,6.944444E-04,1.000000E-02, AAMA2497 + 1 9.37500E-04,4.064421E-05,3.511660E-03,6.503074E-05,2.107000E-02,AAMA2498 + 2 9.290105E-05,2.064468E-06/ AAMA2499 + DATA COEO/1.693122E-03,1.015873E-02,1.984127E-05,2.125850E-04, AAMA2500 + 1 3.985969E-07,5.734633E-08,1.47462E-05,5.461556E-09,2.654316E-05,AAMA2501 + 2 7.646177E-07,1.365389E-06/ AAMA2502 + DATA COED/1.333333E+00,2.133333E+01,1.066667E+01,7.111111E+00/ AAMA2503 + DATA IPC/0,0,0/ $ DATA IPN/0/ $ DATA IDIR/0/ $ DATA IVERS/0/ AAMA2504 + DATA LL/0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19/ AAMA2505 + DATA POP/ 6*1.000/ $ DATA JM,JD,JQ,JO/10*1,14*1,15*1,15*1/ AAMA2506 + DATA EHIGH,ELOW,CLIMIT,ERES/20.000,0.040,1.000E-06,0.000300/ AAMA2507 + DATA ICC,CD,EA,EB/0,1.0E-1,1.0E-2,1.0E-3,1.0E-4,1.0E-5,99.,99./ AAMA2508 + DATA NPOL/20*-1/ $ DATA ESP/0.000/ $ DATA IDE/10000/ AAMA2509 + DATA A,CFM,TFM,STEP,RMATCH,WIDTHK/140.0,0.000,2.3001,0.000E00, AAMA2510 + 1 0.000E00,0.000E00/ $ DATA NOPT,NMAX,ALEXP/0,15,0.000/ AAMA2511 + DATA AMASSA,AMASSN,HBAR/0.000,931.48,6.582173E-16/ $ DATA IP8/0/AAMA2512 + DATA ZMK,ZML,ZMM,ZMKM,ZMLM,ZMMM/2.0,4.0,9.0,4.0,8.0,18.0/ AAMA2513 + DATA IYC,IJ,YJ,JJ1/0,1,1,1,1,0.000,0.000,0.000,0.000,1,1,1,1/ AAMA2514 + DATA EXPMON/ 4.531799,4.706453,4.736786,3.471234,3.150354, AAMA2515 + 1 3.052991,4.703517,3.459110,3.249048,3.150354,2.977822,2.917974, AAMA2516 + 2 3.312419,2.695684,2.533755,4.914818,2.970119,2.700216,6.548446, AAMA2517 + 3 3.199174,2.830713,2.695684,2.415030,2.323143,2.974074,2.526711, AAMA2518 + 4 2.402950,2.415030,2.249824,2.188693/ AAMA2519 + DATA EXPDIP/ 3.766185,4.397381,4.511374,2.429543,2.723240, AAMA2520 + 1 2.747787,2.976262,2.927947,2.886848,4.076930,3.354237,3.192531, AAMA2521 + 2 2.723240,2.747093,2.736171,2.064114,2.209579,2.187568,2.546045, AAMA2522 + 3 2.374398,2.298389,2.876576,2.498902,2.385350,3.993301,2.876576, AAMA2523 + 4 2.652421,5.778643,3.134388,2.797892,2.209579,2.154546,2.118914, AAMA2524 + 5 2.374398,2.234588,2.178575,2.876576,2.498902,2.385350,2.154546, AAMA2525 + 6 2.084353,2.051376/ AAMA2526 + DATA EXPQUA/ 3.531162,4.240205,4.388131,2.543817,2.683365, AAMA2527 + 1 2.694792,2.131239,2.520683,2.579500,2.566813,2.816281,2.819550, AAMA2528 + 2 2.520683,2.607425,2.618563,1.726067,1.977932,1.998559,2.061514, AAMA2529 + 3 2.104925,2.087356,2.283507,2.199915,2.155173,2.183688,2.283507, AAMA2530 + 4 2.245050,2.663082,2.438142,2.347529,1.977932,1.998217,1.987446, AAMA2531 + 5 2.104925,2.062287,2.036313,4.340990,2.986053,2.726274,2.283507, AAMA2532 + 6 2.199915,2.155173,1.998217,1.972396,1.956081/ AAMA2533 + DATA EXPOCT/ 3.429305,4.153371,4.322206,1.982441,2.395708, AAMA2534 + 1 2.470619,2.341001,2.538774,2.572215,2.195239,2.571516,2.623072, AAMA2535 + 2 2.395708,2.512490,2.537093,1.558161,1.837921,1.876801,1.841217, AAMA2536 + 3 1.946305,1.953014,2.017891,2.026300,2.011369,1.778407,2.017891, AAMA2537 + 4 2.032372,2.117493,2.140989,2.117166,1.837921,1.892340,1.895838, AAMA2538 + 5 1.946305,1.948185,1.938261,2.252893,2.331797,2.283271,2.017891, AAMA2539 + 6 2.026300,2.011369,1.892340,1.921936,1.898511/ AAMA2540 + DATA COEMON/ 9.278462E-01,-4.686876E-02, 2.606690E-03, AAMA2541 + 1 3.258145E-01,-1.650726E-02, 9.192955E-04,-8.728775E-02, AAMA2542 + 2 5.557533E-03,-3.299306E-04, 1.650726E-02,-7.889860E-04, AAMA2543 + 3 1.644805E-05, 1.837462E-01,-9.081039E-03, 5.039261E-04, AAMA2544 + 4 -7.674657E-02, 4.090333E-03,-2.414850E-04, 6.976183E-03, AAMA2545 + 5 -3.308179E-04, 2.022719E-05, 9.886183E-03,-4.700158E-04, AAMA2546 + 6 9.786634E-06,-1.115213E-03, 5.895603E-05,-1.271168E-06, AAMA2547 + 7 4.522730E-05,-1.882362E-06, 2.089122E-08/ AAMA2548 + DATA COEDIP/ 9.864278E-02,-3.552196E-03, 6.908681E-05, AAMA2549 + 1 2.415974E-02,-8.812569E-04, 1.721286E-05,-6.819236E-03, AAMA2550 + 2 3.101739E-04,-6.390954E-06, 7.532858E-02,-4.445121E-03, AAMA2551 + 3 2.592835E-04, 2.203142E-04,-8.210685E-06, 8.801341E-08, AAMA2552 + 4 3.235460E-02,-1.181545E-03, 2.303800E-05,-1.225112E-02, AAMA2553 + 5 5.542601E-04,-1.140757E-05, 8.892663E-04,-4.580119E-05, AAMA2554 + 6 9.800079E-07, 1.211143E-02,-6.669497E-04, 3.872454E-05, AAMA2555 + 7 -1.512719E-03, 7.933719E-05,-4.808937E-06, 4.376093E-05, AAMA2556 + 8 -1.627056E-06, 1.743224E-08,-5.132038E-06, 2.095740E-07, AAMA2557 + 9 -2.313305E-09, 2.223166E-04,-1.145030E-05, 2.450020E-07, AAMA2558 + A 9.039198E-08,-3.079553E-09, 2.088144E-11/ AAMA2559 + DATA COEQUA/ 1.411675E-01,-3.944496E-03, 3.945040E-05, AAMA2560 + 1 3.270497E-01,-1.133197E-02, 1.194093E-04,-2.776085E-01, AAMA2561 + 2 7.846003E-03,-7.866167E-05, 4.601989E-01,-1.831626E-02, AAMA2562 + 3 3.675330E-04, 3.487113E-03,-1.060614E-04, 6.944398E-07, AAMA2563 + 4 1.253120E-00,-3.541941E-02, 3.549579E-04,-4.926037E-01, AAMA2564 + 5 1.705249E-02,-1.796112E-04, 3.681114E-02,-1.438755E-03, AAMA2565 + 6 1.569441E-05, 4.626170E-01,-1.840557E-02, 3.690030E-04, AAMA2566 + 7 -4.608811E-02, 2.220260E-03,-4.671028E-05, 7.870980E-03, AAMA2567 + 8 -2.392062E-04, 1.565542E-06,-9.473607E-04, 3.134314E-05, AAMA2568 + 9 -2.107953E-07, 4.492433E-02,-2.608238E-03, 1.552426E-04, AAMA2569 + A 9.202786E-03,-3.596887E-04, 3.923602E-06, 5.980154E-05, AAMA2570 + B -1.722622E-06, 7.889632E-09/ AAMA2571 + DATA COEOCT/ 1.835095E-02,-4.182848E-04, 2.558331E-06, AAMA2572 + 1 1.444508E-01,-3.328672E-03, 2.037957E-05,-4.367688E-02, AAMA2573 + 2 1.223204E-03,-7.847840E-06, 3.021241E-01,-8.987655E-03, AAMA2574 + 3 9.179069E-05, 4.438300E-03,-1.140520E-04, 5.042711E-07, AAMA2575 + 4 1.467168E-00,-3.379181E-02, 2.068045E-04,-5.924030E-01, AAMA2576 + 5 1.655453E-02,-1.061699E-04, 4.508567E-02,-1.416945E-03, AAMA2577 + 6 9.394653E-06, 6.820167E-01,-2.028855E-02, 2.071180E-04, AAMA2578 + 7 -6.910950E-02, 2.487891E-03,-2.660315E-05, 2.252870E-02, AAMA2579 + 8 -5.785850E-04, 2.556806E-06,-2.759089E-03, 7.677244E-05, AAMA2580 + 9 -3.479514E-07, 3.778402E-01,-1.582449E-02, 3.229544E-04, AAMA2581 + A 4.508567E-03,-1.416945E-04, 9.394653E-07, 1.285744E-06, AAMA2582 + B -3.257990E-08, 1.067759E-10/ $ END AAMA2583 +" 7/8/9 CARD -- END-OF-RECORD --------------------------------- AAMA2584 +C AAMA2585 +C ******************************************************************* AAMA2586 +C * DATA FOR THE TEST CASE OF THE PROGRAM. COLS. 1-3 HAVE THE * AAMA2587 +C * ACTION CODE, 12-72 HAVE THE DATA WITH COMMENTS FOLLOWING, AND * AAMA2588 +C * 7-8 EXPLAIN THE UTILITY OF EACH CARD AS FOLLOWS (THIS FEATURE * AAMA2589 +C * IS FOR THE CONVENIENCE OF THE READER) * AAMA2590 +C * 1) NE = CARD IS NECESSARY -- PROGRAM WILL NOT RUN IF W/O * AAMA2591 +C * 2) OR = THIS CARD OVERRIDES DEFAULTS SET IN THE PROGRAM * AAMA2592 +C * 3) DE = REPEATS DEFAULTS -- UNNECESSARY, BUT ILLUSTRATES * AAMA2593 +C * USE OF PARAMETERS. CAN BE TAKEN OUT. * AAMA2594 +C * 4) FR = NO DEFAULT FOR THIS CARD. * AAMA2595 +C * 5) CARDS WITH OR < > IN COLS. 1-3 ARE IGNORED * AAMA2596 +C * ALL OF THE INPUT FEATURES ARE DEMONSTRATED FOR THE CASE SHOWN * AAMA2597 +C ******************************************************************* AAMA2598 +C -------------------------<<< FIT FOR THALLIUM >>>--------------------AAMA2599 +Z NE 81.000 ;ATOMIC NUMBER OF ELEMENT UNDER STUDY (NEEDED) AAMA2600 +ZS OR 80.0 78.0 72.0 ;EFFECTIVE CHARGE FOR THE 3 SHELLS K,L,M AAMA2601 +BE NE 83103.0 14000.0 300.0 ;BINDING ENERGIES IN EV FOR Z-1 (=80)AAMA2602 +K DE 3 4 4 4 ; NUMBER OF CASES FOR EACH MULTIPOLARITY AAMA2603 +NN0 DE 1 2 3 ;MONOPOLE SHELL SELECTION CODES AAMA2604 +NN1 DE 0 1 2 3 ;DIPOLE SHELL SELECTION CODES AAMA2605 +NN2 DE 0 1 2 3 ;QUADRUPOLE SHELL SELECTION CODES AAMA2606 +NN3 DE 0 1 2 3 ;OCTUPOLE SHELL SELECTION CODES AAMA2607 +M1 DE 0 0 0 0 ;DIPOLE SUBSHELL SELECTION CODES AAMA2608 +M2 DE 0 0 0 0 ;QUADRUPOLE SUBSHELL SELECTION CODES AAMA2609 +M3 DE 0 0 0 0 ;OCTUPOLE SUBSHELL SELECTION CODES AAMA2610 +IP1 DE 0 1 1 1 ;DIPOLE SHELL PENETRATION SELECTION CODES AAMA2611 +IP2 DE 0 1 1 1 ;QUADRUPOLE SHELL PENETRATION SELECTION CODES AAMA2612 +IP3 DE 0 1 1 1 ;OCTUPOLE SHELL PENETRATION SELECTION CODES AAMA2613 +JTM DE 1 1 1 1 1 1 ;MONOPOLE - NUMBER OF TERMS IN PENETRATION AAMA2614 +JTD DE 1 1 1 1 1 1 ;DIPOLE - NUMBER OF TERMS IN PENETRATION AAMA2615 +JTQ DE 1 1 1 1 1 1 ;QUADRUPOLE - NUMBER OF TERMS IN PENETRATION AAMA2616 +JTO DE 1 1 1 1 1 1 ;OCTUPOLE - NUMBER OF TERMS IN PENETRATION AAMA2617 +IC DE 3 ;DETAIL LEVEL OF ACCURACY CONTROL (MAXIMUM) AAMA2618 +IRE DE 5 ;READ UNIT -- IBM STANDARD AAMA2619 +IWR DE 6 ;WRITE UNIT -- IBM STANDARD AAMA2620 +IPU DE 7 ;PUNCH UNIT -- IBM STANDARD (PUNCH IS OPTIONAL) AAMA2621 +IPR OR 8 ;PRINT OPTIONS (DETAILED PRINT EXCEPT ALL X-RAYS) AAMA2622 +FD DE 15.000 ;FACTORIAL DIVIDER (10.000 IS MORE CUSTOMARY) AAMA2623 +IDB DE 0 ;DEBUG OPTION (NO) -- DEBUG PRINTS ALL RATES AAMA2624 +IPN DE 0 ;PUNCH SELECTION (YES) -- OTHERWISE NO PUNCH AAMA2625 +IDE DE 10000 ;PUNCH IDENTIFICATION NUMBER IN COL.S 73-77 AAMA2626 +KWD OR 10.000 ;REFILLING WIDTH OF 1S ELECTRON STATE IN EV AAMA2627 +POP DE 1. 1. 1. 1. 1. 1. ;POPUL. OF SUBSHELLS (FRACT. OF TOTAL) AAMA2628 +D21 OR 5810000. ;2P-1S AVERAGE TRANSITION ENERGY OF MUON IN EV AAMA2629 +ESP OR 1100000. ;2S-2P TRANSITION ENERGY (AVERAGE) FOR MUON IN EV AAMA2630 +NOP DE 0 ;INITIAL DISTRIBUTION OPTION (MODIFIED STATISTICAL) AAMA2631 +NMX OR 18 0.0871 ;STARTING N AND EXPONENT OF STAT. DISTRIBUTION AAMA2632 +IP DE 0 ;USE L-DISTRIBUTION AT N=NMAX ONLY AAMA2633 +CL DE 0.0 0.0 ;QUADRATIC DISTRIBUTION PARAM.S -- NOT APPLICABLE AAMA2634 +IPC OR 0 1 1 ;ELECTRON REFILLING CODES (L AND M -- NO DEPLETION) AAMA2635 +NPL DE -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 AAMA2636 +C ** ;START QUANTAL DEPOLARIZATION FROM THE BEGINNING (CODES) AAMA2637 +IPL DE 0 ;DO DEPOLARIZATION CALCULATION AAMA2638 +YC OR 1.0 1.0 1.0 1.0 ;UNCONDITIONAL Y-CUTOFF FOR PENETRATION AAMA2639 +AMM DE 206.7686 ;MASS OF THE MUON IN ELECTRON MASSES AAMA2640 +AME DE 511003.4 ;MASS OF THE ELECTRON IN EV AAMA2641 +AMN DE 931.48 ;AVERAGE NUCLEON BOUND MASS IN MEV AAMA2642 +A OR 205.00 ;A-NUMBER OF ISOTOPE IN QUESTION AAMA2643 +CT OR 6.6173 2.301 ;C, T FERMI DISTRIBUTION PARAMETERS (NOT USED) AAMA2644 +STP OR 1.0 1.0 ;STEP AND MATCHING RADIUS (NOT USED HERE, BUT PRNTD)AAMA2645 +EHI OR 4.200 ;UPPER LIMIT FOR THE X-RAY TABLE IN MEV AAMA2646 +ELO OR 0.400 ;LOWER LIMIT IN THE X-RAY INTENSITY TABLE IN MEV AAMA2647 +CLM OR 3.0E-4 ;LOWER LIMIT IN LINE INTENSITY OF TABLE (PER MUON) AAMA2648 +ERS OR 0.001 ;ENERGY RESOLUTION OF THE TABLE IN MEV AAMA2649 +ICC OR 1 ;USE INPUTTED STAR POINTS FOR TABLE (SEE NEXT CARD) AAMA2650 +CD FR .2 .05 .01 .002 .0005 ;NEW STAR DIVIDING POINTS AAMA2651 +EAB OR 1000. 1. ;CALIBRATION POINTS TO CONVERT ENERGY TO CHANNEL NO.AAMA2652 +DIR FR 1 1 0.0 10.42234 ;CARDS WITH CODE CAN BE USED TO AAMA2653 +DIR FR 2 1 0.0 3.52678 ;INPUT DIRAC ENERGIES FOR ANY N AND K AAMA2654 +DIR FR 2 2 0.0 4.70447 ;DESCRIBING A DIRAC STATE. THE FORMAT IS AAMA2655 +DIR FR 2 3 0.0 4.52465 ;N K (S=1,P-DOWN=2,P-UP=3, ETC.) SCREEN- AAMA2656 +DIR FR 3 1 0.0 2.04931 *;ING ENERGY (OPTIONAL) AND BINDIND ENERGY.AAMA2657 +DIR FR 3 2 0.0 2.08884 ;FOR THE EXPERIMENTALIST THIS WILL AID IN AAMA2658 +DIR FR 3 3 0.0 2.04256 ;IDENTIFYING THE LINES FOUND. WE USE AAMA2659 +DIR FR 3 4 0.0 2.11887 ;ONLY THE LOWEST 3 SHELLS, SINCE WE ARE AAMA2660 +DIR FR 3 5 0.0 2.07803 ;NOT CONCERNED WITH SUCH IDENTIFICATION. AAMA2661 +C ** * = DIRAC ENERGY NOT AVAILABLE -- SCHROEDINGER VALUE USED. AAMA2662 +PUN FR 7 0 0 6 0 0 2 ; THE CARDS WITH THE CODE CAUSE AAMA2663 +PUN FR 11 0 0 8 0 0 2 ; THE CORRESPONDING TRANSITION AAMA2664 +PUN FR 9 0 0 7 0 0 2 ; INTENSITIES TO BE PUNCHED. AAMA2665 +PUN FR 12 0 0 8 0 0 2 ; THIS PARTICULAR SET WAS USED TO AAMA2666 +PUN FR 13 0 0 8 0 0 2 ; FIT THE EXPERIMENTAL DATA FOR AAMA2667 +PUN FR 10 0 0 7 0 0 2 ; THALLIUM. NOTE THAT IF THE AAMA2668 +PUN FR 8 0 0 6 0 0 2 ; INTENSITY IS TOO LOW THE AAMA2669 +PUN FR 11 0 0 7 0 0 2 ; TRANSITION MIGHT BE SKIPPED. AAMA2670 +PUN FR 6 0 0 5 0 0 2 ; AAMA2671 +PUN FR 12 0 0 7 0 0 2 ; AAMA2672 +PUN FR 13 0 0 7 0 0 2 ; AAMA2673 +PUN FR 9 0 0 6 0 0 2 ; AAMA2674 +PUN FR 10 0 0 6 0 0 2 ; AAMA2675 +PUN FR 11 0 0 6 0 0 2 ; AAMA2676 +PUN FR 7 0 0 5 0 0 2 ; AAMA2677 +PUN FR 12 0 0 6 0 0 2 ; AAMA2678 +PUN FR 5 4 0 4 3 1 0 ; AAMA2679 +PUN FR 5 4 1 4 3 1 0 ; AAMA2680 +PUN FR 5 4 0 4 3 0 0 ; AAMA2681 +PUN FR 5 3 1 4 2 1 0 ; AAMA2682 +PUN FR 5 3 0 4 2 1 0 ; AAMA2683 +PUN FR 5 3 0 4 2 0 0 ; AAMA2684 +PUN FR 8 0 0 5 0 0 2 ; AAMA2685 +PUN FR 9 0 0 5 0 0 2 ; AAMA2686 +PUN FR 9 3 1 5 2 1 0 ; AAMA2687 +PUN FR 9 4 0 5 3 0 0 ; AAMA2688 +PUN FR 6 4 1 4 3 1 0 ; AAMA2689 +PUN FR 6 4 0 4 3 0 0 ; AAMA2690 +PUN FR 6 3 1 4 2 1 0 ; AAMA2691 +PUN FR 6 3 0 4 2 0 0 ; AAMA2692 +PUN FR 7 4 1 4 3 1 0 ; AAMA2693 +PUN FR 7 4 0 4 3 1 0 ; AAMA2694 +PUN FR 7 4 0 4 3 0 0 ; AAMA2695 +PUN FR 4 2 1 3 1 1 0 ; AAMA2696 +PUN FR 4 2 0 3 1 0 0 ; AAMA2697 +PUN FR 4 2 0 3 1 1 0 ; AAMA2698 +PUN FR 4 3 0 3 2 1 0 ; AAMA2699 +PUN FR 4 3 1 3 2 1 0 ; AAMA2700 +PUN FR 4 3 0 3 2 0 0 ; AAMA2701 +PUN FR 2 0 1 2 1 0 0 ; AAMA2702 +PUN FR 5 4 1 3 2 1 0 ; AAMA2703 +PUN FR 5 3 1 3 2 1 0 ; AAMA2704 +PUN FR 5 3 0 3 2 1 0 ; AAMA2705 +PUN FR 5 3 0 3 2 0 0 ; AAMA2706 +PUN FR 5 4 0 3 2 0 0 ; AAMA2707 +PUN FR 3 1 0 2 0 1 0 ; AAMA2708 +PUN FR 3 1 1 2 0 1 0 ; AAMA2709 +PUN FR 4 2 0 2 1 1 0 ; AAMA2710 +PUN FR 4 3 0 2 1 1 0 ; AAMA2711 +PUN FR 4 2 1 2 1 1 0 ; AAMA2712 +PUN FR 4 3 1 2 1 1 0 ; AAMA2713 +PUN FR 4 3 0 2 1 0 0 ; AAMA2714 +PL FR 0 0.000 ;SINCE NOP IS SET TO 0 (NOT -1) PL CARDS DO NOT AAMA2715 +PL FR 1 1.000 ;HAVE ANY EFFECT. THIS SAMPLE DEMONSTRATES THEIR AAMA2716 +PL FR 2 2.000 ;USE. THE INTEGER IS THE L VALUE AND THE REAL IS AAMA2717 +PL FR 3 3.000 ;UNNORMALIZED POPULATION OF THE (N=NMX,L) STATE AAMA2718 +PL FR 4 4.000 ;TO BE NORMALIZED IN THE PROG. NMX NUMBER OF PL AAMA2719 +PL FR 5 5.000 ;CARDS NEEDED IN GENERAL TO SET ALL L STATES AAMA2720 +PLN OR 18 0 8 0.9 1. 3. 5. 7. 9. 11. 13. 15. 17. AAMA2721 +PLN OR 18 9 17 2.7 19. 21. 23. 25. 27. 29. 31. 33. 35. AAMA2722 +C ** ;THE ABOVE SAMPLE SETS THE POPULATION OF THE N=18 STATES IN AAMA2723 +C ** ;A STATISTICAL DISTRIBUTION WITH TOTAL UNNORMALIZED SUM OF AAMA2724 +C ** ;3.6 (=0.9+2.7) TO BE USED WITH IP=1. OTHER SETS OF N-STATESAAMA2725 +C ** ;CAN BE SET SIMILARLY (IF UNSPECIFIED THEY ARE TAKEN AS ZERO.AAMA2726 +C ** ;NORMALIZATION IS DONE BY THE PROGRAM SO THAT THE GRAND SUM AAMA2727 +C ** ;OVER N AND L IS UNITY. IF THE SUM ON THE CARD (FOURTH AAMA2728 +C ** ;ENTRY) IS ZERO, THE POPULATIONS ARE NOT ADJUSTED TO THE SUM,AAMA2729 +C ** ;BUT ARE NORMALIZED AS THEY STAND. AAMA2730 +XEQ NE ALL IS SET; GO AHEAD AND CALCULATE THE CASCADE... AAMA2731 +C ** 5 SHORTER CASES FOLLOW FOR ILLUSTRATION. FEWER FEATURES INCL.AAMA2732 +IPR OR 13 ;GET LESS PRINTOUT (ONLY RELEVANT RESULTS...) AAMA2733 +IC OR 0 ;NO ARITHMETIC ACCURACY CHECK FROM HERE ON... AAMA2734 +IPN OR 1 ;NO PUNCH FROM HERE ON..FITS WILL NOT BE GOOD ANYWAYAAMA2735 +K OR 3 4 4 0 ;SKIP CALCULATION OF OCTUPOLE TRANSITIONS... AAMA2736 +IDE OR 10001 ;NEW CASE IDENTIFICATION NUMBER AAMA2737 +XEQ NE ---------------------------------- AAMA2738 +K OR 3 4 0 0 ;NOW IN ADDITION SKIP QUADRUPOLE TRANSITIONS TOO AAMA2739 +IDE OR 10002 ;NEW CASE IDENTIFICATION NUMBER AAMA2740 +XEQ NE ---------------------------------- AAMA2741 +K OR 1 4 0 0 ;IN ADDITION SKIP MONOPOLE L AND M SHELLS AAMA2742 +IDE OR 10003 ;NEW CASE IDENTIFICATION NUMBER AAMA2743 +XEQ NE ---------------------------------- AAMA2744 +PLN OR 17 0 8 .11211 1. 3. 5. 7. 9. 11. 13. 15. 17. ;USED W/ OTHERAAMA2745 +PLN OR 17 9 16 .28789 19. 21. 23. 25. 27. 29. 31. 33. ;PLN CARDS... AAMA2746 +IP OR 1 ;START L-DIST. W/ STAT. 90 PCT AT N=18,10PCT AT N=17AAMA2747 +IPC 1 1 1 ;THE ELECTRONIC SHELLS MUST REMAIN FULL IN THIS CASEAAMA2748 +IPL 1 ;PROGRAM CANNOT DO DEPOLARIZATION IN THIS CASE AAMA2749 +IDE OR 10004 ;NEW CASE IDENTIFICATION NUMBER AAMA2750 +XEQ NE ---------------------------------- AAMA2751 +IP1 OR 0 0 0 0 ;NO PENETRATION IN THIS CASE (NOTE TIME SAVING) AAMA2752 +IDE OR 10005 ;NEW CASE IDENTIFICATION NUMBER AAMA2753 +XEQ NE ---------------------------------- AAMA2754 +C ** OTHER SPECIFICATION CARDS FOLLOWED BY CARDS AS REQU- AAMA2755 +C ** IRED. THE PROGRAM CHANGES ONLY THE PARAMETERS SPECIFIED. AAMA2756 +STO(P)NE FOR A NORMAL TERMINATION, THIS IS THE LAST INPUT CARD. AAMA2757 +" 7/8/9 CARD -- END-OF-RECORD --------------------------------- AAMA2758 +" 6/7/8/9 CARD -- END-OF-JOB ************************************ AAMA2759 +** END-OF-TRANSMISSION CARD (INSTALLATION DEPENDENT) AAMA2760 + AAMA**** diff --git a/src/api.cpp b/src/api.cpp new file mode 100644 index 0000000..b77d6b4 --- /dev/null +++ b/src/api.cpp @@ -0,0 +1,586 @@ +#include "mocca/api.hpp" + +#include "mocca/kernel.hpp" +#include "embedded_tables.hpp" + +#include +#include +#include +#include +#include + +namespace mocca { + +namespace { + +std::string read_file(const std::filesystem::path& path) { + std::ifstream input(path); + if (!input) { + throw std::runtime_error("Unable to open file: " + path.string()); + } + std::ostringstream buffer; + buffer << input.rdbuf(); + return buffer.str(); +} + +const JsonValue::Object& require_object(const JsonValue& value, std::string_view label) { + if (!value.is_object()) { + throw std::runtime_error(std::string(label) + " must be a JSON object"); + } + return value.as_object(); +} + +const JsonValue::Array& require_array(const JsonValue& value, std::string_view label) { + if (!value.is_array()) { + throw std::runtime_error(std::string(label) + " must be a JSON array"); + } + return value.as_array(); +} + +std::optional find_value(const JsonValue::Object& object, const std::string& key) { + const auto it = object.find(key); + if (it == object.end()) { + return std::nullopt; + } + return &it->second; +} + +double require_number(const JsonValue::Object& object, const std::string& key) { + const auto value = find_value(object, key); + if (!value.has_value() || !(*value)->is_number()) { + throw std::runtime_error("Missing numeric field: " + key); + } + return (*value)->as_number(); +} + +int checked_int(double value, std::string_view key) { + if (!std::isfinite(value) || std::trunc(value) != value) { + throw std::runtime_error(std::string(key) + " must be an integer"); + } + if (value < static_cast(std::numeric_limits::min()) || + value > static_cast(std::numeric_limits::max())) { + throw std::runtime_error(std::string(key) + " is outside the supported integer range"); + } + return static_cast(value); +} + +int require_int(const JsonValue::Object& object, const std::string& key) { + return checked_int(require_number(object, key), key); +} + +std::string require_string(const JsonValue::Object& object, const std::string& key) { + const auto value = find_value(object, key); + if (!value.has_value() || !(*value)->is_string()) { + throw std::runtime_error("Missing string field: " + key); + } + return (*value)->as_string(); +} + +std::optional optional_number(const JsonValue::Object& object, const std::string& key) { + const auto value = find_value(object, key); + if (!value.has_value()) { + return std::nullopt; + } + if ((*value)->is_null()) { + return std::nullopt; + } + if (!(*value)->is_number()) { + throw std::runtime_error("Field must be numeric: " + key); + } + return (*value)->as_number(); +} + +std::optional optional_int(const JsonValue::Object& object, const std::string& key) { + const auto value = optional_number(object, key); + if (!value.has_value()) { + return std::nullopt; + } + return checked_int(*value, key); +} + +bool optional_bool(const JsonValue::Object& object, const std::string& key, bool default_value) { + const auto value = find_value(object, key); + if (!value.has_value()) { + return default_value; + } + if (!(*value)->is_bool()) { + throw std::runtime_error("Field must be bool: " + key); + } + return (*value)->as_bool(); +} + +std::vector number_array(const JsonValue::Object& object, const std::string& key) { + const auto values = find_value(object, key); + if (!values.has_value()) { + return {}; + } + std::vector numbers; + for (const JsonValue& item : require_array(*(*values), key)) { + if (!item.is_number()) { + throw std::runtime_error("Array " + key + " must contain only numbers"); + } + numbers.push_back(item.as_number()); + } + return numbers; +} + +std::optional> optional_number_array( + const JsonValue::Object& object, + const std::string& key) { + const auto value = find_value(object, key); + if (!value.has_value()) { + return std::nullopt; + } + std::vector numbers; + for (const JsonValue& item : require_array(*(*value), key)) { + if (!item.is_number()) { + throw std::runtime_error("Array " + key + " must contain only numbers"); + } + numbers.push_back(item.as_number()); + } + return numbers; +} + +std::optional> optional_int_array( + const JsonValue::Object& object, + const std::string& key) { + const auto values = optional_number_array(object, key); + if (!values.has_value()) { + return std::nullopt; + } + std::vector ints; + ints.reserve(values->size()); + for (double number : *values) { + ints.push_back(checked_int(number, key)); + } + return ints; +} + +JsonValue number_array_json(const std::vector& values) { + JsonValue::Array array; + array.reserve(values.size()); + for (double value : values) { + array.emplace_back(value); + } + return JsonValue(std::move(array)); +} + +JsonValue int_array_json(const std::vector& values) { + JsonValue::Array array; + array.reserve(values.size()); + for (int value : values) { + array.emplace_back(value); + } + return JsonValue(std::move(array)); +} + +CaptureMode parse_capture_mode(const std::string& raw_mode) { + if (raw_mode == "statistical_l") { + return CaptureMode::statistical_l; + } + if (raw_mode == "quadratic_l") { + return CaptureMode::quadratic_l; + } + if (raw_mode == "explicit_l") { + return CaptureMode::explicit_l; + } + if (raw_mode == "explicit_nl") { + return CaptureMode::explicit_nl; + } + if (raw_mode == "legacy_empty") { + return CaptureMode::legacy_empty; + } + throw std::runtime_error("Unsupported capture mode: " + raw_mode); +} + +std::string capture_mode_name(CaptureMode mode) { + switch (mode) { + case CaptureMode::statistical_l: + return "statistical_l"; + case CaptureMode::quadratic_l: + return "quadratic_l"; + case CaptureMode::explicit_l: + return "explicit_l"; + case CaptureMode::explicit_nl: + return "explicit_nl"; + case CaptureMode::legacy_empty: + return "legacy_empty"; + } + throw std::runtime_error("Unhandled capture mode"); +} + +JsonValue dirac_energy_json(const DiracEnergy& entry) { + return JsonValue::Object{ + {"binding_kev", entry.binding_kev}, + {"kappa", entry.kappa}, + {"n", entry.n}, + {"vacuum_polarization_kev", entry.vacuum_polarization_kev}, + }; +} + +JsonValue nl_weight_json(const NlWeight& entry) { + return JsonValue::Object{ + {"l", entry.l}, + {"n", entry.n}, + {"weight", entry.weight}, + }; +} + +JsonValue optional_number_json(const std::optional& value) { + if (!value.has_value()) { + return JsonValue(nullptr); + } + return JsonValue(*value); +} + +} // namespace + +SimulationConfig parse_config_text(std::string_view text) { + const JsonValue root = parse_json(text); + const JsonValue::Object& object = require_object(root, "root"); + + SimulationConfig config; + if (const auto schema = optional_int(object, "schema_version"); schema.has_value()) { + config.schema_version = *schema; + } + if (config.schema_version != 1) { + throw std::runtime_error("Unsupported schema_version: " + std::to_string(config.schema_version)); + } + if (const auto metadata_value = find_value(object, "metadata"); metadata_value.has_value()) { + const JsonValue::Object& metadata = require_object(*(*metadata_value), "metadata"); + if (const auto case_name = find_value(metadata, "case_name"); case_name.has_value()) { + if (!(*case_name)->is_string()) { + throw std::runtime_error("metadata.case_name must be a string"); + } + config.metadata.case_name = (*case_name)->as_string(); + } + } + + const JsonValue::Object& atom = require_object(object.at("atom"), "atom"); + config.atom.atomic_number = require_number(atom, "atomic_number"); + config.atom.effective_shell_charges = number_array(atom, "effective_shell_charges"); + config.atom.binding_energies_ev = number_array(atom, "binding_energies_ev"); + config.atom.atomic_mass = require_number(atom, "atomic_mass"); + config.atom.exact_mass_number = optional_number(atom, "exact_mass_number"); + + if (const auto masses_value = find_value(object, "masses"); masses_value.has_value()) { + const JsonValue::Object& masses = require_object(*(*masses_value), "masses"); + if (const auto value = optional_number(masses, "muon_electron_masses"); value.has_value()) { + config.masses.muon_electron_masses = *value; + } + if (const auto value = optional_number(masses, "electron_mass_ev"); value.has_value()) { + config.masses.electron_mass_ev = *value; + } + if (const auto value = optional_number(masses, "nucleon_mass_mev"); value.has_value()) { + config.masses.nucleon_mass_mev = *value; + } + } + + if (const auto transitions_value = find_value(object, "transitions"); transitions_value.has_value()) { + const JsonValue::Object& transitions = require_object(*(*transitions_value), "transitions"); + config.transitions.two_p_to_one_s_energy_ev = optional_number(transitions, "two_p_to_one_s_energy_ev"); + config.transitions.two_s_to_two_p_split_ev = optional_number(transitions, "two_s_to_two_p_split_ev"); + if (const auto entries_value = find_value(transitions, "dirac_energies"); entries_value.has_value()) { + for (const JsonValue& entry_value : require_array(*(*entries_value), "transitions.dirac_energies")) { + const JsonValue::Object& entry = require_object(entry_value, "dirac energy entry"); + config.transitions.dirac_energies.push_back(DiracEnergy{ + require_int(entry, "n"), + require_int(entry, "kappa"), + optional_number(entry, "vacuum_polarization_kev").value_or(0.0), + require_number(entry, "binding_kev"), + }); + } + } + } + + const JsonValue::Object& capture = require_object(object.at("capture"), "capture"); + config.capture.mode = parse_capture_mode(require_string(capture, "mode")); + config.capture.n_max = require_int(capture, "n_max"); + if (const auto value = optional_number(capture, "alpha"); value.has_value()) { + config.capture.alpha = *value; + } + config.capture.quadratic_coefficients = number_array(capture, "quadratic_coefficients"); + config.capture.l_weights = number_array(capture, "l_weights"); + if (const auto nl_weights_value = find_value(capture, "nl_weights"); nl_weights_value.has_value()) { + for (const JsonValue& entry_value : require_array(*(*nl_weights_value), "capture.nl_weights")) { + const JsonValue::Object& entry = require_object(entry_value, "capture.nl_weights entry"); + config.capture.nl_weights.push_back(NlWeight{ + require_int(entry, "n"), + require_int(entry, "l"), + require_number(entry, "weight"), + }); + } + } + + if (const auto channels_value = find_value(object, "channels"); channels_value.has_value()) { + const JsonValue::Object& channels = require_object(*(*channels_value), "channels"); + if (const auto values = optional_int_array(channels, "case_counts"); values.has_value()) { + config.channels.case_counts = *values; + } + if (const auto values = optional_int_array(channels, "monopole_shells"); values.has_value()) { + config.channels.monopole_shells = *values; + } + if (const auto values = optional_int_array(channels, "dipole_shells"); values.has_value()) { + config.channels.dipole_shells = *values; + } + if (const auto values = optional_int_array(channels, "quadrupole_shells"); values.has_value()) { + config.channels.quadrupole_shells = *values; + } + if (const auto values = optional_int_array(channels, "octupole_shells"); values.has_value()) { + config.channels.octupole_shells = *values; + } + if (const auto values = optional_int_array(channels, "dipole_subshell_channels"); values.has_value()) { + config.channels.dipole_subshell_channels = *values; + } + if (const auto values = optional_int_array(channels, "quadrupole_subshell_channels"); + values.has_value()) { + config.channels.quadrupole_subshell_channels = *values; + } + if (const auto values = optional_int_array(channels, "octupole_subshell_channels"); + values.has_value()) { + config.channels.octupole_subshell_channels = *values; + } + if (const auto values = optional_int_array(channels, "dipole_penetration_codes"); + values.has_value()) { + config.channels.dipole_penetration_codes = *values; + } + if (const auto values = optional_int_array(channels, "quadrupole_penetration_codes"); + values.has_value()) { + config.channels.quadrupole_penetration_codes = *values; + } + if (const auto values = optional_int_array(channels, "octupole_penetration_codes"); + values.has_value()) { + config.channels.octupole_penetration_codes = *values; + } + if (const auto values = optional_int_array(channels, "dipole_penetration_avg_n_cutoffs"); + values.has_value()) { + config.channels.dipole_penetration_avg_n_cutoffs = *values; + } + if (const auto values = + optional_int_array(channels, "quadrupole_penetration_avg_n_cutoffs"); + values.has_value()) { + config.channels.quadrupole_penetration_avg_n_cutoffs = *values; + } + if (const auto values = optional_int_array(channels, "octupole_penetration_avg_n_cutoffs"); + values.has_value()) { + config.channels.octupole_penetration_avg_n_cutoffs = *values; + } + } + + if (const auto shell_value = find_value(object, "shell_model"); shell_value.has_value()) { + const JsonValue::Object& shell_model = require_object(*(*shell_value), "shell_model"); + if (const auto values = optional_number_array(shell_model, "subshell_populations"); + values.has_value()) { + config.shell_model.subshell_populations = *values; + } + if (const auto values = optional_int_array(shell_model, "refill_codes"); values.has_value()) { + config.shell_model.refill_codes = *values; + } + if (const auto values = optional_number_array(shell_model, "penetration_cutoffs"); + values.has_value()) { + config.shell_model.penetration_cutoffs = *values; + } + if (const auto value = optional_number(shell_model, "width_k_ev"); value.has_value()) { + config.shell_model.width_k_ev = *value; + } + config.shell_model.track_polarization = optional_bool(shell_model, "track_polarization", true); + } + + if (const auto reporting_value = find_value(object, "reporting"); reporting_value.has_value()) { + const JsonValue::Object& reporting = require_object(*(*reporting_value), "reporting"); + if (const auto value = optional_number(reporting, "line_energy_min_mev"); value.has_value()) { + config.reporting.line_energy_min_mev = *value; + } + if (const auto value = optional_number(reporting, "line_energy_max_mev"); value.has_value()) { + config.reporting.line_energy_max_mev = *value; + } + if (const auto value = optional_number(reporting, "line_intensity_threshold"); value.has_value()) { + config.reporting.line_intensity_threshold = *value; + } + if (const auto value = optional_number(reporting, "energy_resolution_mev"); value.has_value()) { + config.reporting.energy_resolution_mev = *value; + } + } + + if (const auto model_value = find_value(object, "model"); model_value.has_value()) { + const JsonValue::Object& model = require_object(*(*model_value), "model"); + if (const auto value = optional_number(model, "factorial_divider"); value.has_value()) { + config.model.factorial_divider = *value; + } + } + + if (const auto numerics_value = find_value(object, "numerics"); numerics_value.has_value()) { + const JsonValue::Object& numerics = require_object(*(*numerics_value), "numerics"); + if (const auto value = optional_int(numerics, "matrix_element_precision_digits"); + value.has_value()) { + config.numerics.matrix_element_precision_digits = *value; + } else if (const auto legacy_value = optional_int(numerics, "stable_precision_digits"); + legacy_value.has_value()) { + config.numerics.matrix_element_precision_digits = *legacy_value; + } + } + if (config.numerics.matrix_element_precision_digits <= 0) { + throw std::runtime_error( + "numerics.matrix_element_precision_digits must be a positive integer"); + } + + return config; +} + +SimulationConfig load_config(const std::filesystem::path& path) { + return parse_config_text(read_file(path)); +} + +JsonValue to_json(const SimulationConfig& config) { + JsonValue::Array dirac_energies; + dirac_energies.reserve(config.transitions.dirac_energies.size()); + for (const DiracEnergy& entry : config.transitions.dirac_energies) { + dirac_energies.push_back(dirac_energy_json(entry)); + } + + JsonValue::Array nl_weights; + nl_weights.reserve(config.capture.nl_weights.size()); + for (const NlWeight& entry : config.capture.nl_weights) { + nl_weights.push_back(nl_weight_json(entry)); + } + + return JsonValue::Object{ + {"schema_version", config.schema_version}, + {"metadata", JsonValue::Object{ + {"case_name", config.metadata.case_name}, + }}, + {"atom", JsonValue::Object{ + {"atomic_number", config.atom.atomic_number}, + {"atomic_mass", config.atom.atomic_mass}, + {"binding_energies_ev", number_array_json(config.atom.binding_energies_ev)}, + {"effective_shell_charges", number_array_json(config.atom.effective_shell_charges)}, + {"exact_mass_number", optional_number_json(config.atom.exact_mass_number)}, + }}, + {"masses", JsonValue::Object{ + {"electron_mass_ev", config.masses.electron_mass_ev}, + {"muon_electron_masses", config.masses.muon_electron_masses}, + {"nucleon_mass_mev", config.masses.nucleon_mass_mev}, + }}, + {"transitions", JsonValue::Object{ + {"dirac_energies", JsonValue(std::move(dirac_energies))}, + {"two_p_to_one_s_energy_ev", optional_number_json(config.transitions.two_p_to_one_s_energy_ev)}, + {"two_s_to_two_p_split_ev", optional_number_json(config.transitions.two_s_to_two_p_split_ev)}, + }}, + {"capture", JsonValue::Object{ + {"alpha", config.capture.alpha}, + {"l_weights", number_array_json(config.capture.l_weights)}, + {"mode", capture_mode_name(config.capture.mode)}, + {"n_max", config.capture.n_max}, + {"nl_weights", JsonValue(std::move(nl_weights))}, + {"quadratic_coefficients", number_array_json(config.capture.quadratic_coefficients)}, + }}, + {"channels", JsonValue::Object{ + {"case_counts", int_array_json(config.channels.case_counts)}, + {"dipole_penetration_avg_n_cutoffs", int_array_json(config.channels.dipole_penetration_avg_n_cutoffs)}, + {"dipole_penetration_codes", int_array_json(config.channels.dipole_penetration_codes)}, + {"dipole_shells", int_array_json(config.channels.dipole_shells)}, + {"dipole_subshell_channels", int_array_json(config.channels.dipole_subshell_channels)}, + {"monopole_shells", int_array_json(config.channels.monopole_shells)}, + {"octupole_penetration_avg_n_cutoffs", int_array_json(config.channels.octupole_penetration_avg_n_cutoffs)}, + {"octupole_penetration_codes", int_array_json(config.channels.octupole_penetration_codes)}, + {"octupole_shells", int_array_json(config.channels.octupole_shells)}, + {"octupole_subshell_channels", int_array_json(config.channels.octupole_subshell_channels)}, + {"quadrupole_penetration_avg_n_cutoffs", int_array_json(config.channels.quadrupole_penetration_avg_n_cutoffs)}, + {"quadrupole_penetration_codes", int_array_json(config.channels.quadrupole_penetration_codes)}, + {"quadrupole_shells", int_array_json(config.channels.quadrupole_shells)}, + {"quadrupole_subshell_channels", int_array_json(config.channels.quadrupole_subshell_channels)}, + }}, + {"shell_model", JsonValue::Object{ + {"penetration_cutoffs", number_array_json(config.shell_model.penetration_cutoffs)}, + {"refill_codes", int_array_json(config.shell_model.refill_codes)}, + {"subshell_populations", number_array_json(config.shell_model.subshell_populations)}, + {"track_polarization", config.shell_model.track_polarization}, + {"width_k_ev", config.shell_model.width_k_ev}, + }}, + {"reporting", JsonValue::Object{ + {"energy_resolution_mev", config.reporting.energy_resolution_mev}, + {"line_energy_max_mev", config.reporting.line_energy_max_mev}, + {"line_energy_min_mev", config.reporting.line_energy_min_mev}, + {"line_intensity_threshold", config.reporting.line_intensity_threshold}, + }}, + {"model", JsonValue::Object{ + {"factorial_divider", config.model.factorial_divider}, + }}, + {"numerics", JsonValue::Object{ + {"matrix_element_precision_digits", config.numerics.matrix_element_precision_digits}, + }}, + }; +} + +JsonValue to_json(const SimulationResult& result) { + JsonValue::Array lines; + lines.reserve(result.lines.size()); + for (const TransitionLine& line : result.lines) { + lines.push_back(JsonValue::Object{ + {"energy_kev", line.energy_kev}, + {"intensity", line.intensity}, + {"j1_twice", line.j1_twice}, + {"j2_twice", line.j2_twice}, + {"l1", line.l1}, + {"l2", line.l2}, + {"multipole", line.multipole}, + {"n1", line.n1}, + {"n2", line.n2}, + }); + } + + JsonValue::Array states; + states.reserve(result.states.size()); + for (const StateSummary& state : result.states) { + states.push_back(JsonValue::Object{ + {"k_electrons", state.k_electrons}, + {"l", state.l}, + {"l_electrons", state.l_electrons}, + {"m_electrons", state.m_electrons}, + {"n", state.n}, + {"polar_down", optional_number_json(state.polar_down)}, + {"polar_up", optional_number_json(state.polar_up)}, + {"population", state.population}, + {"rad_to_auger", optional_number_json(state.rad_to_auger)}, + {"spin_orbit_ev", optional_number_json(state.spin_orbit_ev)}, + {"width_ev", optional_number_json(state.width_ev)}, + }); + } + + JsonValue::Array warnings; + warnings.reserve(result.warnings.size()); + for (const std::string& warning : result.warnings) { + warnings.emplace_back(warning); + } + + return JsonValue::Object{ + {"lines", JsonValue(std::move(lines))}, + {"lyman_sum", result.lyman_sum}, + {"num_lines", result.num_lines}, + {"states", JsonValue(std::move(states))}, + {"warnings", JsonValue(std::move(warnings))}, + }; +} + +JsonValue to_json(const SimulationArtifact& artifact) { + return JsonValue::Object{ + {"coefficient_table_id", artifact.coefficient_table_id}, + {"implementation_name", artifact.implementation_name}, + {"input", to_json(artifact.input)}, + {"numerical_backend", artifact.numerical_backend}, + {"result", to_json(artifact.result)}, + {"schema_version", artifact.schema_version}, + {"matrix_element_precision_digits", artifact.matrix_element_precision_digits}, + }; +} + +SimulationArtifact run_simulation(const SimulationConfig& config) { + SimulationArtifact artifact; + artifact.coefficient_table_id = std::string(detail::kBundledCoefficientTableId); + artifact.matrix_element_precision_digits = config.numerics.matrix_element_precision_digits; + artifact.input = config; + artifact.result = run_modern_kernel(config); + return artifact; +} + +} // namespace mocca diff --git a/src/cli.cpp b/src/cli.cpp new file mode 100644 index 0000000..8183f9f --- /dev/null +++ b/src/cli.cpp @@ -0,0 +1,59 @@ +#include "mocca/api.hpp" + +#include +#include +#include +#include +#include + +namespace { + +void print_usage() { + std::cerr << "Usage: mocca [--output result.json]\n"; +} + +void write_text(const std::filesystem::path& path, const std::string& text) { + std::ofstream output(path); + if (!output) { + throw std::runtime_error("Unable to open output file: " + path.string()); + } + output << text; +} + +} // namespace + +int main(int argc, char** argv) { + try { + if (argc < 2) { + print_usage(); + return 2; + } + + std::filesystem::path config_path = argv[1]; + std::filesystem::path output_path; + + for (int i = 2; i < argc; ++i) { + const std::string arg = argv[i]; + if (arg == "--output" && i + 1 < argc) { + output_path = argv[++i]; + } else { + throw std::runtime_error("Unknown or incomplete argument: " + arg); + } + } + + const mocca::SimulationConfig config = mocca::load_config(config_path); + const mocca::SimulationArtifact artifact = mocca::run_simulation(config); + const std::string payload = + mocca::to_json_string(mocca::to_json(artifact), 2); + + if (!output_path.empty()) { + write_text(output_path, payload); + } else { + std::cout << payload; + } + return 0; + } catch (const std::exception& exc) { + std::cerr << exc.what() << '\n'; + return 1; + } +} diff --git a/src/config_bridge.cpp b/src/config_bridge.cpp new file mode 100644 index 0000000..78c8517 --- /dev/null +++ b/src/config_bridge.cpp @@ -0,0 +1,299 @@ +#include "config_bridge.hpp" + +#include +#include +#include +#include + +namespace mocca::detail { + +namespace { + +template +void set_one_based(std::vector& destination, const std::vector& source) { + const std::size_t capacity = destination.empty() ? 0 : destination.size() - 1; + if (source.size() > capacity) { + throw std::runtime_error("Input vector exceeds the supported capacity"); + } + for (std::size_t i = 0; i < source.size(); ++i) { + destination[i + 1] = source[i]; + } +} + +template +void require_exact_size( + const std::vector& values, + std::size_t expected_size, + std::string_view field_name) { + if (values.size() != expected_size) { + std::ostringstream out; + out << field_name << " must contain exactly " << expected_size + << " value(s); received " << values.size(); + throw std::runtime_error(out.str()); + } +} + +void require_int_range( + int value, + int min_value, + int max_value, + std::string_view field_name) { + if (value < min_value || value > max_value) { + std::ostringstream out; + out << field_name << " must be between " << min_value << " and " << max_value + << "; received " << value; + throw std::runtime_error(out.str()); + } +} + +void require_values_in_range( + const std::vector& values, + int min_value, + int max_value, + std::string_view field_name) { + for (std::size_t index = 0; index < values.size(); ++index) { + if (values[index] < min_value || values[index] > max_value) { + std::ostringstream out; + out << field_name << "[" << index << "] must be between " << min_value << " and " + << max_value << "; received " << values[index]; + throw std::runtime_error(out.str()); + } + } +} + +void apply_dirac_energies( + KernelState& cfg, + const std::vector& dirac_energies) { + if (dirac_energies.empty()) { + return; + } + cfg.icc = 1; + for (const DiracEnergy& entry : dirac_energies) { + if (entry.n < 0 || entry.n >= static_cast(cfg.energy.size())) { + throw std::runtime_error("Dirac energy n is out of supported range"); + } + if (entry.kappa < 0 || entry.kappa >= static_cast(cfg.energy[entry.n].size())) { + throw std::runtime_error("Dirac energy kappa is out of supported range"); + } + double value = entry.binding_kev + entry.vacuum_polarization_kev; + if (entry.vacuum_polarization_kev < 0.0) { + cfg.idr += 1; + } + cfg.energy[entry.n][entry.kappa] = value; + } +} + +void apply_capture(KernelState& cfg, const CaptureConfig& capture) { + cfg.nmax = capture.n_max; + cfg.ip8 = 0; + cfg.nopt = 1; + std::fill(cfg.pl.begin(), cfg.pl.end(), 0.0); + std::fill(cfg.pln.begin(), cfg.pln.end(), 0.0); + + switch (capture.mode) { + case CaptureMode::statistical_l: + cfg.nopt = 0; + cfg.alexp = capture.alpha; + break; + case CaptureMode::quadratic_l: + cfg.nopt = 2; + require_exact_size( + capture.quadratic_coefficients, + 2, + "capture.quadratic_coefficients"); + cfg.cl1 = capture.quadratic_coefficients[0]; + cfg.cl2 = capture.quadratic_coefficients[1]; + break; + case CaptureMode::explicit_l: + require_exact_size( + capture.l_weights, + static_cast(capture.n_max), + "capture.l_weights"); + for (std::size_t index = 0; index < capture.l_weights.size(); ++index) { + if (index + 1 >= cfg.pl.size()) { + break; + } + cfg.pl[index + 1] = capture.l_weights[index]; + } + break; + case CaptureMode::explicit_nl: + cfg.ip8 = 1; + if (capture.nl_weights.empty()) { + throw std::runtime_error("explicit_nl mode requires nl_weights"); + } + for (const NlWeight& weight : capture.nl_weights) { + if (weight.n < 1 || weight.n > cfg.nmax || weight.l < 0 || weight.l >= weight.n) { + throw std::runtime_error("explicit_nl weights contain an invalid (n,l) state"); + } + const int index = state_index(weight.n, weight.l); + if (index >= static_cast(cfg.pln.size())) { + throw std::runtime_error("explicit_nl state exceeds the supported n range"); + } + cfg.pln[index] = weight.weight; + } + break; + case CaptureMode::legacy_empty: + cfg.nopt = 4; + break; + } +} + +} // namespace + +KernelState build_kernel_config( + const NumericTables& numeric_tables, + const SimulationConfig& config) { + KernelState cfg(numeric_tables); + + require_exact_size(config.atom.effective_shell_charges, 3, "atom.effective_shell_charges"); + require_exact_size(config.atom.binding_energies_ev, 3, "atom.binding_energies_ev"); + if (config.capture.n_max < 1 || config.capture.n_max > 20) { + throw std::runtime_error("capture.n_max must be between 1 and 20"); + } + + cfg.z = config.atom.atomic_number; + cfg.zsk = config.atom.effective_shell_charges[0]; + cfg.zsl = config.atom.effective_shell_charges[1]; + cfg.zsm = config.atom.effective_shell_charges[2]; + cfg.be[1] = config.atom.binding_energies_ev[0]; + cfg.be[2] = config.atom.binding_energies_ev[1]; + cfg.be[3] = config.atom.binding_energies_ev[2]; + cfg.a = config.atom.atomic_mass; + if (config.atom.exact_mass_number.has_value()) { + cfg.amassa = *config.atom.exact_mass_number; + } + + cfg.amassm = config.masses.muon_electron_masses; + cfg.amasse = config.masses.electron_mass_ev; + cfg.amassn = config.masses.nucleon_mass_mev; + if (!std::isfinite(config.model.factorial_divider) || config.model.factorial_divider <= 0.0) { + throw std::runtime_error("model.factorial_divider must be finite and strictly positive"); + } + cfg.fd = config.model.factorial_divider; + + if (config.transitions.two_p_to_one_s_energy_ev.has_value()) { + cfg.d2p1s = *config.transitions.two_p_to_one_s_energy_ev; + } + if (config.transitions.two_s_to_two_p_split_ev.has_value()) { + cfg.esp = *config.transitions.two_s_to_two_p_split_ev; + } + apply_dirac_energies(cfg, config.transitions.dirac_energies); + + require_exact_size(config.channels.case_counts, 4, "channels.case_counts"); + require_int_range( + config.channels.case_counts[0], + 0, + static_cast(cfg.nn0.size()) - 1, + "channels.case_counts[0]"); + require_int_range( + config.channels.case_counts[1], + 0, + static_cast(cfg.nn1.size()) - 1, + "channels.case_counts[1]"); + require_int_range( + config.channels.case_counts[2], + 0, + static_cast(cfg.nn2.size()) - 1, + "channels.case_counts[2]"); + require_int_range( + config.channels.case_counts[3], + 0, + static_cast(cfg.nn3.size()) - 1, + "channels.case_counts[3]"); + cfg.k0 = config.channels.case_counts[0]; + cfg.k1 = config.channels.case_counts[1]; + cfg.k2 = config.channels.case_counts[2]; + cfg.k3 = config.channels.case_counts[3]; + require_exact_size( + config.channels.monopole_shells, + static_cast(cfg.k0), + "channels.monopole_shells"); + require_exact_size( + config.channels.dipole_shells, + static_cast(cfg.k1), + "channels.dipole_shells"); + require_exact_size( + config.channels.quadrupole_shells, + static_cast(cfg.k2), + "channels.quadrupole_shells"); + require_exact_size( + config.channels.octupole_shells, + static_cast(cfg.k3), + "channels.octupole_shells"); + require_exact_size( + config.channels.dipole_subshell_channels, + static_cast(cfg.k1), + "channels.dipole_subshell_channels"); + require_exact_size( + config.channels.quadrupole_subshell_channels, + static_cast(cfg.k2), + "channels.quadrupole_subshell_channels"); + require_exact_size( + config.channels.octupole_subshell_channels, + static_cast(cfg.k3), + "channels.octupole_subshell_channels"); + require_exact_size( + config.channels.dipole_penetration_codes, + static_cast(cfg.k1), + "channels.dipole_penetration_codes"); + require_exact_size( + config.channels.quadrupole_penetration_codes, + static_cast(cfg.k2), + "channels.quadrupole_penetration_codes"); + require_exact_size( + config.channels.octupole_penetration_codes, + static_cast(cfg.k3), + "channels.octupole_penetration_codes"); + require_exact_size( + config.channels.dipole_penetration_avg_n_cutoffs, + static_cast(cfg.k1), + "channels.dipole_penetration_avg_n_cutoffs"); + require_exact_size( + config.channels.quadrupole_penetration_avg_n_cutoffs, + static_cast(cfg.k2), + "channels.quadrupole_penetration_avg_n_cutoffs"); + require_exact_size( + config.channels.octupole_penetration_avg_n_cutoffs, + static_cast(cfg.k3), + "channels.octupole_penetration_avg_n_cutoffs"); + require_values_in_range(config.channels.monopole_shells, 1, 3, "channels.monopole_shells"); + require_values_in_range(config.channels.dipole_shells, 0, 3, "channels.dipole_shells"); + require_values_in_range( + config.channels.quadrupole_shells, + 0, + 3, + "channels.quadrupole_shells"); + require_values_in_range(config.channels.octupole_shells, 0, 3, "channels.octupole_shells"); + set_one_based(cfg.nn0, config.channels.monopole_shells); + set_one_based(cfg.nn1, config.channels.dipole_shells); + set_one_based(cfg.nn2, config.channels.quadrupole_shells); + set_one_based(cfg.nn3, config.channels.octupole_shells); + set_one_based(cfg.m1, config.channels.dipole_subshell_channels); + set_one_based(cfg.m2, config.channels.quadrupole_subshell_channels); + set_one_based(cfg.m3, config.channels.octupole_subshell_channels); + set_one_based(cfg.ip1, config.channels.dipole_penetration_codes); + set_one_based(cfg.ip2, config.channels.quadrupole_penetration_codes); + set_one_based(cfg.ip3, config.channels.octupole_penetration_codes); + set_one_based(cfg.iq1, config.channels.dipole_penetration_avg_n_cutoffs); + set_one_based(cfg.iq2, config.channels.quadrupole_penetration_avg_n_cutoffs); + set_one_based(cfg.iq3, config.channels.octupole_penetration_avg_n_cutoffs); + + require_exact_size(config.shell_model.subshell_populations, 6, "shell_model.subshell_populations"); + require_exact_size(config.shell_model.refill_codes, 3, "shell_model.refill_codes"); + require_exact_size(config.shell_model.penetration_cutoffs, 4, "shell_model.penetration_cutoffs"); + set_one_based(cfg.pop, config.shell_model.subshell_populations); + set_one_based(cfg.ipc, config.shell_model.refill_codes); + set_one_based(cfg.yc, config.shell_model.penetration_cutoffs); + cfg.widthk = config.shell_model.width_k_ev; + cfg.ipol = config.shell_model.track_polarization ? 0 : 1; + + cfg.elow = config.reporting.line_energy_min_mev; + cfg.ehigh = config.reporting.line_energy_max_mev; + cfg.climit = config.reporting.line_intensity_threshold; + cfg.eres = config.reporting.energy_resolution_mev; + + apply_capture(cfg, config.capture); + return cfg; +} + +} // namespace mocca::detail diff --git a/src/config_bridge.hpp b/src/config_bridge.hpp new file mode 100644 index 0000000..35232ff --- /dev/null +++ b/src/config_bridge.hpp @@ -0,0 +1,12 @@ +#pragma once + +#include "mocca/api.hpp" +#include "physics_engine.hpp" + +namespace mocca::detail { + +[[nodiscard]] KernelState build_kernel_config( + const NumericTables& numeric_tables, + const SimulationConfig& config); + +} // namespace mocca::detail diff --git a/src/embedded_tables.cpp b/src/embedded_tables.cpp new file mode 100644 index 0000000..a4f56f0 --- /dev/null +++ b/src/embedded_tables.cpp @@ -0,0 +1,395 @@ +// Generated by tools/export_embedded_tables.py from muon00.f block-data tables. +// Do not edit this file by hand; regenerate it when the bundled coefficient source changes. +#include "embedded_tables.hpp" + +namespace mocca::detail { + +NumericTables bundled_numeric_tables() { + return NumericTables{ + {"COEDP", std::vector{ + 21.33333, + 42.66667, + 3.555556, + 113.7778, + 7.111111, + 56.88889, + 1024, + 22.75556, + 1228.8 + }}, + {"COEQ", std::vector{ + 0.06666667, + 0.08888889, + 0.0006944444, + 0.01, + 0.0009375, + 4.064421e-05, + 0.00351166, + 6.503074e-05, + 0.02107, + 9.290105e-05, + 2.064468e-06 + }}, + {"COEO", std::vector{ + 0.001693122, + 0.01015873, + 1.984127e-05, + 0.000212585, + 3.985969e-07, + 5.734633e-08, + 1.47462e-05, + 5.461556e-09, + 2.654316e-05, + 7.646177e-07, + 1.365389e-06 + }}, + {"COED", std::vector{ + 1.333333, + 21.33333, + 10.66667, + 7.111111 + }}, + {"EXPMON", std::vector{ + 4.531799, + 4.706453, + 4.736786, + 3.471234, + 3.150354, + 3.052991, + 4.703517, + 3.45911, + 3.249048, + 3.150354, + 2.977822, + 2.917974, + 3.312419, + 2.695684, + 2.533755, + 4.914818, + 2.970119, + 2.700216, + 6.548446, + 3.199174, + 2.830713, + 2.695684, + 2.41503, + 2.323143, + 2.974074, + 2.526711, + 2.40295, + 2.41503, + 2.249824, + 2.188693 + }}, + {"EXPDIP", std::vector{ + 3.766185, + 4.397381, + 4.511374, + 2.429543, + 2.72324, + 2.747787, + 2.976262, + 2.927947, + 2.886848, + 4.07693, + 3.354237, + 3.192531, + 2.72324, + 2.747093, + 2.736171, + 2.064114, + 2.209579, + 2.187568, + 2.546045, + 2.374398, + 2.298389, + 2.876576, + 2.498902, + 2.38535, + 3.993301, + 2.876576, + 2.652421, + 5.778643, + 3.134388, + 2.797892, + 2.209579, + 2.154546, + 2.118914, + 2.374398, + 2.234588, + 2.178575, + 2.876576, + 2.498902, + 2.38535, + 2.154546, + 2.084353, + 2.051376 + }}, + {"EXPQUA", std::vector{ + 3.531162, + 4.240205, + 4.388131, + 2.543817, + 2.683365, + 2.694792, + 2.131239, + 2.520683, + 2.5795, + 2.566813, + 2.816281, + 2.81955, + 2.520683, + 2.607425, + 2.618563, + 1.726067, + 1.977932, + 1.998559, + 2.061514, + 2.104925, + 2.087356, + 2.283507, + 2.199915, + 2.155173, + 2.183688, + 2.283507, + 2.24505, + 2.663082, + 2.438142, + 2.347529, + 1.977932, + 1.998217, + 1.987446, + 2.104925, + 2.062287, + 2.036313, + 4.34099, + 2.986053, + 2.726274, + 2.283507, + 2.199915, + 2.155173, + 1.998217, + 1.972396, + 1.956081 + }}, + {"EXPOCT", std::vector{ + 3.429305, + 4.153371, + 4.322206, + 1.982441, + 2.395708, + 2.470619, + 2.341001, + 2.538774, + 2.572215, + 2.195239, + 2.571516, + 2.623072, + 2.395708, + 2.51249, + 2.537093, + 1.558161, + 1.837921, + 1.876801, + 1.841217, + 1.946305, + 1.953014, + 2.017891, + 2.0263, + 2.011369, + 1.778407, + 2.017891, + 2.032372, + 2.117493, + 2.140989, + 2.117166, + 1.837921, + 1.89234, + 1.895838, + 1.946305, + 1.948185, + 1.938261, + 2.252893, + 2.331797, + 2.283271, + 2.017891, + 2.0263, + 2.011369, + 1.89234, + 1.921936, + 1.898511 + }}, + {"COEMON", std::vector{ + 0.9278462, + -0.04686876, + 0.00260669, + 0.3258145, + -0.01650726, + 0.0009192955, + -0.08728775, + 0.005557533, + -0.0003299306, + 0.01650726, + -0.000788986, + 1.644805e-05, + 0.1837462, + -0.009081039000000001, + 0.0005039261, + -0.07674657, + 0.004090333, + -0.000241485, + 0.006976183, + -0.0003308179, + 2.022719e-05, + 0.009886183, + -0.0004700158, + 9.786634e-06, + -0.001115213, + 5.895603e-05, + -1.271168e-06, + 4.52273e-05, + -1.882362e-06, + 2.089122e-08 + }}, + {"COEDIP", std::vector{ + 0.09864278, + -0.003552196, + 6.908681e-05, + 0.02415974, + -0.0008812568999999999, + 1.721286e-05, + -0.006819236, + 0.0003101739, + -6.390954e-06, + 0.07532858000000001, + -0.004445121, + 0.0002592835, + 0.0002203142, + -8.210685e-06, + 8.801341e-08, + 0.0323546, + -0.001181545, + 2.3038e-05, + -0.01225112, + 0.0005542601, + -1.140757e-05, + 0.0008892663, + -4.580119e-05, + 9.800079e-07, + 0.01211143, + -0.0006669497, + 3.872454e-05, + -0.001512719, + 7.933719e-05, + -4.808937e-06, + 4.376093e-05, + -1.627056e-06, + 1.743224e-08, + -5.132038e-06, + 2.09574e-07, + -2.313305e-09, + 0.0002223166, + -1.14503e-05, + 2.45002e-07, + 9.039198e-08, + -3.079553e-09, + 2.088144e-11 + }}, + {"COEQUA", std::vector{ + 0.1411675, + -0.003944496, + 3.94504e-05, + 0.3270497, + -0.01133197, + 0.0001194093, + -0.2776085, + 0.007846003000000001, + -7.866167e-05, + 0.4601989, + -0.01831626, + 0.000367533, + 0.003487113, + -0.0001060614, + 6.944398e-07, + 1.25312, + -0.03541941, + 0.0003549579, + -0.4926037, + 0.01705249, + -0.0001796112, + 0.03681114, + -0.001438755, + 1.569441e-05, + 0.462617, + -0.01840557, + 0.000369003, + -0.04608811, + 0.00222026, + -4.671028e-05, + 0.00787098, + -0.0002392062, + 1.565542e-06, + -0.0009473607, + 3.134314e-05, + -2.107953e-07, + 0.04492433, + -0.002608238, + 0.0001552426, + 0.009202785999999999, + -0.0003596887, + 3.923602e-06, + 5.980154e-05, + -1.722622e-06, + 7.889632e-09 + }}, + {"COEOCT", std::vector{ + 0.01835095, + -0.0004182848, + 2.558331e-06, + 0.1444508, + -0.003328672, + 2.037957e-05, + -0.04367688, + 0.001223204, + -7.847840000000001e-06, + 0.3021241, + -0.008987655000000001, + 9.179068999999999e-05, + 0.0044383, + -0.000114052, + 5.042711e-07, + 1.467168, + -0.03379181, + 0.0002068045, + -0.592403, + 0.01655453, + -0.0001061699, + 0.04508567, + -0.001416945, + 9.394653e-06, + 0.6820167, + -0.02028855, + 0.000207118, + -0.0691095, + 0.002487891, + -2.660315e-05, + 0.0225287, + -0.000578585, + 2.556806e-06, + -0.002759089, + 7.677244000000001e-05, + -3.479514e-07, + 0.3778402, + -0.01582449, + 0.0003229544, + 0.004508567, + -0.0001416945, + 9.394653e-07, + 1.285744e-06, + -3.25799e-08, + 1.067759e-10 + }}, + }; +} + +} // namespace mocca::detail diff --git a/src/embedded_tables.hpp b/src/embedded_tables.hpp new file mode 100644 index 0000000..c650801 --- /dev/null +++ b/src/embedded_tables.hpp @@ -0,0 +1,15 @@ +#pragma once + +#include + +#include "physics_engine.hpp" + +namespace mocca::detail { + +// Bump this identifier whenever the embedded coefficient tables are regenerated +// from a materially different published source. +inline constexpr std::string_view kBundledCoefficientTableId = "aama_v1_0_block_data_v1"; + +[[nodiscard]] NumericTables bundled_numeric_tables(); + +} // namespace mocca::detail diff --git a/src/json.cpp b/src/json.cpp new file mode 100644 index 0000000..b8363ff --- /dev/null +++ b/src/json.cpp @@ -0,0 +1,515 @@ +#include "mocca/json.hpp" + +#include +#include +#include +#include +#include +#include + +namespace mocca { + +JsonValue::JsonValue(std::nullptr_t) : data_(nullptr) {} +JsonValue::JsonValue(bool value) : data_(value) {} +JsonValue::JsonValue(double value) : data_(value) {} +JsonValue::JsonValue(int value) : data_(static_cast(value)) {} +JsonValue::JsonValue(std::string value) : data_(std::move(value)) {} +JsonValue::JsonValue(const char* value) { + if (value == nullptr) { + throw std::runtime_error("JSON string pointer is null"); + } + data_ = std::string(value); +} +JsonValue::JsonValue(Array value) : data_(std::move(value)) {} +JsonValue::JsonValue(Object value) : data_(std::move(value)) {} + +bool JsonValue::is_null() const { + return std::holds_alternative(data_); +} + +bool JsonValue::is_bool() const { + return std::holds_alternative(data_); +} + +bool JsonValue::is_number() const { + return std::holds_alternative(data_); +} + +bool JsonValue::is_string() const { + return std::holds_alternative(data_); +} + +bool JsonValue::is_array() const { + return std::holds_alternative(data_); +} + +bool JsonValue::is_object() const { + return std::holds_alternative(data_); +} + +bool JsonValue::as_bool() const { + if (!is_bool()) { + throw std::runtime_error("JSON value is not a bool"); + } + return std::get(data_); +} + +double JsonValue::as_number() const { + if (!is_number()) { + throw std::runtime_error("JSON value is not a number"); + } + return std::get(data_); +} + +const std::string& JsonValue::as_string() const { + if (!is_string()) { + throw std::runtime_error("JSON value is not a string"); + } + return std::get(data_); +} + +const JsonValue::Array& JsonValue::as_array() const { + if (!is_array()) { + throw std::runtime_error("JSON value is not an array"); + } + return std::get(data_); +} + +const JsonValue::Object& JsonValue::as_object() const { + if (!is_object()) { + throw std::runtime_error("JSON value is not an object"); + } + return std::get(data_); +} + +JsonValue::Array& JsonValue::as_array() { + if (!is_array()) { + throw std::runtime_error("JSON value is not an array"); + } + return std::get(data_); +} + +JsonValue::Object& JsonValue::as_object() { + if (!is_object()) { + throw std::runtime_error("JSON value is not an object"); + } + return std::get(data_); +} + +bool JsonValue::contains(const std::string& key) const { + if (!is_object()) { + return false; + } + return as_object().contains(key); +} + +const JsonValue& JsonValue::at(const std::string& key) const { + return as_object().at(key); +} + +namespace { + +class Parser { +public: + explicit Parser(std::string_view text) : text_(text) {} + + JsonValue parse() { + skip_ws(); + JsonValue value = parse_value(); + skip_ws(); + if (pos_ != text_.size()) { + throw error("Unexpected trailing JSON content"); + } + return value; + } + +private: + [[nodiscard]] std::runtime_error error(const std::string& message) const { + std::ostringstream out; + out << message << " at byte " << pos_; + return std::runtime_error(out.str()); + } + + void skip_ws() { + while (pos_ < text_.size() && std::isspace(static_cast(text_[pos_])) != 0) { + ++pos_; + } + } + + char peek() const { + if (pos_ >= text_.size()) { + throw error("Unexpected end of JSON"); + } + return text_[pos_]; + } + + char consume() { + const char ch = peek(); + ++pos_; + return ch; + } + + void expect(char expected) { + const char actual = consume(); + if (actual != expected) { + std::ostringstream out; + out << "Expected '" << expected << "' but found '" << actual << "'"; + throw error(out.str()); + } + } + + bool consume_if(char ch) { + if (pos_ < text_.size() && text_[pos_] == ch) { + ++pos_; + return true; + } + return false; + } + + JsonValue parse_value() { + skip_ws(); + switch (peek()) { + case 'n': + parse_keyword("null"); + return JsonValue(nullptr); + case 't': + parse_keyword("true"); + return JsonValue(true); + case 'f': + parse_keyword("false"); + return JsonValue(false); + case '"': + return JsonValue(parse_string()); + case '[': + return JsonValue(parse_array()); + case '{': + return JsonValue(parse_object()); + default: + return JsonValue(parse_number()); + } + } + + void parse_keyword(std::string_view keyword) { + for (char ch : keyword) { + if (consume() != ch) { + throw error("Invalid JSON keyword"); + } + } + } + + std::string parse_string() { + expect('"'); + std::string value; + while (true) { + if (pos_ >= text_.size()) { + throw error("Unterminated JSON string"); + } + const char ch = consume(); + if (ch == '"') { + return value; + } + if (ch != '\\') { + if (static_cast(ch) < 0x20) { + throw error("Unescaped control character in JSON string"); + } + value.push_back(ch); + continue; + } + if (pos_ >= text_.size()) { + throw error("Unterminated JSON escape"); + } + const char escape = consume(); + switch (escape) { + case '"': + case '\\': + case '/': + value.push_back(escape); + break; + case 'b': + value.push_back('\b'); + break; + case 'f': + value.push_back('\f'); + break; + case 'n': + value.push_back('\n'); + break; + case 'r': + value.push_back('\r'); + break; + case 't': + value.push_back('\t'); + break; + case 'u': { + std::uint32_t codepoint = parse_hex_codepoint(); + if (codepoint >= 0xD800 && codepoint <= 0xDBFF) { + expect('\\'); + expect('u'); + const std::uint32_t low = parse_hex_codepoint(); + if (low < 0xDC00 || low > 0xDFFF) { + throw error("Invalid low surrogate in JSON string"); + } + codepoint = 0x10000 + ((codepoint - 0xD800) << 10) + (low - 0xDC00); + } else if (codepoint >= 0xDC00 && codepoint <= 0xDFFF) { + throw error("Unexpected low surrogate in JSON string"); + } + append_utf8(value, codepoint); + break; + } + default: + throw error("Invalid JSON escape"); + } + } + } + + int hex_digit(char ch) const { + if (ch >= '0' && ch <= '9') { + return ch - '0'; + } + if (ch >= 'a' && ch <= 'f') { + return 10 + ch - 'a'; + } + if (ch >= 'A' && ch <= 'F') { + return 10 + ch - 'A'; + } + throw error("Invalid hex digit in JSON unicode escape"); + } + + std::uint32_t parse_hex_codepoint() { + std::uint32_t value = 0; + for (int index = 0; index < 4; ++index) { + value = (value << 4) | static_cast(hex_digit(consume())); + } + return value; + } + + void append_utf8(std::string& out, std::uint32_t codepoint) const { + if (codepoint <= 0x7F) { + out.push_back(static_cast(codepoint)); + return; + } + if (codepoint <= 0x7FF) { + out.push_back(static_cast(0xC0 | (codepoint >> 6))); + out.push_back(static_cast(0x80 | (codepoint & 0x3F))); + return; + } + if (codepoint <= 0xFFFF) { + out.push_back(static_cast(0xE0 | (codepoint >> 12))); + out.push_back(static_cast(0x80 | ((codepoint >> 6) & 0x3F))); + out.push_back(static_cast(0x80 | (codepoint & 0x3F))); + return; + } + if (codepoint <= 0x10FFFF) { + out.push_back(static_cast(0xF0 | (codepoint >> 18))); + out.push_back(static_cast(0x80 | ((codepoint >> 12) & 0x3F))); + out.push_back(static_cast(0x80 | ((codepoint >> 6) & 0x3F))); + out.push_back(static_cast(0x80 | (codepoint & 0x3F))); + return; + } + throw error("Unicode codepoint is outside the valid UTF-8 range"); + } + + double parse_number() { + const std::size_t start = pos_; + consume_if('-'); + if (consume_if('0')) { + if (pos_ < text_.size() && std::isdigit(static_cast(text_[pos_])) != 0) { + throw error("Leading zeros are not permitted in JSON numbers"); + } + } else { + if (!std::isdigit(static_cast(peek()))) { + throw error("Invalid JSON number"); + } + while (pos_ < text_.size() && std::isdigit(static_cast(text_[pos_])) != 0) { + ++pos_; + } + } + if (consume_if('.')) { + if (pos_ >= text_.size() || std::isdigit(static_cast(text_[pos_])) == 0) { + throw error("Invalid JSON fractional part"); + } + while (pos_ < text_.size() && std::isdigit(static_cast(text_[pos_])) != 0) { + ++pos_; + } + } + if (consume_if('e') || consume_if('E')) { + consume_if('+') || consume_if('-'); + if (pos_ >= text_.size() || std::isdigit(static_cast(text_[pos_])) == 0) { + throw error("Invalid JSON exponent"); + } + while (pos_ < text_.size() && std::isdigit(static_cast(text_[pos_])) != 0) { + ++pos_; + } + } + const std::string token(text_.substr(start, pos_ - start)); + return std::stod(token); + } + + JsonValue::Array parse_array() { + expect('['); + skip_ws(); + JsonValue::Array values; + if (consume_if(']')) { + return values; + } + while (true) { + values.push_back(parse_value()); + skip_ws(); + if (consume_if(']')) { + return values; + } + expect(','); + skip_ws(); + } + } + + JsonValue::Object parse_object() { + expect('{'); + skip_ws(); + JsonValue::Object values; + if (consume_if('}')) { + return values; + } + while (true) { + skip_ws(); + if (peek() != '"') { + throw error("Expected object key"); + } + std::string key = parse_string(); + skip_ws(); + expect(':'); + skip_ws(); + JsonValue parsed_value = parse_value(); + const auto [it, inserted] = values.emplace(key, std::move(parsed_value)); + if (!inserted) { + throw error("Duplicate object key \"" + key + "\""); + } + skip_ws(); + if (consume_if('}')) { + return values; + } + expect(','); + skip_ws(); + } + } + + std::string_view text_; + std::size_t pos_{0}; +}; + +std::string indent_string(int level, int indent) { + return std::string(static_cast(level * indent), ' '); +} + +std::string escape_string(const std::string& input) { + std::ostringstream out; + out << '"'; + for (unsigned char ch : input) { + switch (ch) { + case '\\': + out << "\\\\"; + break; + case '"': + out << "\\\""; + break; + case '\n': + out << "\\n"; + break; + case '\r': + out << "\\r"; + break; + case '\t': + out << "\\t"; + break; + default: + if (ch < 0x20) { + out << "\\u" << std::uppercase << std::hex << std::setw(4) << std::setfill('0') + << static_cast(ch) + << std::nouppercase << std::dec << std::setfill(' '); + } else { + out << static_cast(ch); + } + break; + } + } + out << '"'; + return out.str(); +} + +std::string number_string(double value) { + if (!std::isfinite(value)) { + throw std::runtime_error("Cannot serialize non-finite JSON number"); + } + std::ostringstream out; + out << std::setprecision(std::numeric_limits::max_digits10) << value; + return out.str(); +} + +void serialize_impl(const JsonValue& value, int indent, int level, std::ostringstream& out) { + if (value.is_null()) { + out << "null"; + return; + } + if (value.is_bool()) { + out << (value.as_bool() ? "true" : "false"); + return; + } + if (value.is_number()) { + out << number_string(value.as_number()); + return; + } + if (value.is_string()) { + out << escape_string(value.as_string()); + return; + } + if (value.is_array()) { + const auto& array = value.as_array(); + if (array.empty()) { + out << "[]"; + return; + } + out << "[\n"; + for (std::size_t i = 0; i < array.size(); ++i) { + out << indent_string(level + 1, indent); + serialize_impl(array[i], indent, level + 1, out); + if (i + 1 != array.size()) { + out << ','; + } + out << '\n'; + } + out << indent_string(level, indent) << ']'; + return; + } + const auto& object = value.as_object(); + if (object.empty()) { + out << "{}"; + return; + } + out << "{\n"; + std::size_t index = 0; + for (const auto& [key, child] : object) { + out << indent_string(level + 1, indent) << escape_string(key) << ": "; + serialize_impl(child, indent, level + 1, out); + if (index + 1 != object.size()) { + out << ','; + } + out << '\n'; + ++index; + } + out << indent_string(level, indent) << '}'; +} + +} // namespace + +JsonValue parse_json(std::string_view text) { + return Parser(text).parse(); +} + +std::string to_json_string(const JsonValue& value, int indent) { + std::ostringstream out; + serialize_impl(value, indent, 0, out); + out << '\n'; + return out.str(); +} + +} // namespace mocca diff --git a/src/kernel.cpp b/src/kernel.cpp new file mode 100644 index 0000000..ce9b98c --- /dev/null +++ b/src/kernel.cpp @@ -0,0 +1,518 @@ +#include "mocca/kernel.hpp" + +#include "config_bridge.hpp" +#include "embedded_tables.hpp" +#include "line_codec.hpp" +#include "physics_engine.hpp" + +#include +#include +#include +#include +#include + +namespace mocca { + +class ModernCascadeKernel::Impl { +public: + explicit Impl(const SimulationConfig& config) + : config_(config), + tables_(detail::bundled_numeric_tables()), + primitives_(tables_, config_.numerics.matrix_element_precision_digits) {} + + [[nodiscard]] SimulationResult run() const { + detail::KernelState cfg = detail::build_kernel_config(tables_, config_); + primitives_.prepare_case(cfg); + auto [lyman_sum, states] = propagate_cascade(cfg); + auto lines = detail::collect_lines(cfg); + return SimulationResult{ + lyman_sum, + static_cast(lines.size()), + std::move(lines), + std::move(states), + cfg.warnings, + }; + } + +private: + [[nodiscard]] static std::array popj(int l1, int l2, int ll) { + std::array p{}; + const int li = ll + 1; + const int l = std::max(l1, l2); + if (li == 1) { + p[1] = static_cast(l + 1) / static_cast(2 * l + 1); + p[2] = 1.0 - p[1]; + return p; + } + if (li == 2) { + p[1] = static_cast((l + 1) * (2 * l - 1)) / static_cast(4 * l * l - 1); + p[2] = 1.0 / static_cast(4 * l * l - 1); + p[3] = 1.0 - (p[1] + p[2]); + return p; + } + if (li == 3) { + if (l1 != l2) { + p[1] = static_cast(l + 1) / static_cast(2 * l + 1); + p[2] = 2.0 / static_cast((2 * l - 3) * (2 * l + 1)); + p[3] = 1.0 - (p[1] + p[2]); + return p; + } + const double d = static_cast((2 * l + 1) * (2 * l + 1)); + p[1] = static_cast((l + 2) * (2 * l - 1)) / d; + p[2] = static_cast((l - 1) * (2 * l + 3)) / d; + p[3] = 3.0 / d; + p[4] = p[3]; + return p; + } + if (std::abs(l1 - l2) != 1) { + p[1] = static_cast(l + 1) / static_cast(2 * l + 1); + p[2] = 3.0 / static_cast((2 * l - 5) * (2 * l + 1)); + p[3] = 1.0 - (p[1] + p[2]); + return p; + } + const double d = static_cast(4 * l * l - 1); + p[1] = static_cast((2 * l - 3) * (l + 2)) / d; + p[2] = 5.0 / d; + p[3] = 6.0 / d; + p[4] = 1.0 - (p[1] + p[2] + p[3]); + return p; + } + + [[nodiscard]] static double beta(int l1, int j1, int l2, int j2, int l) { + const double a1 = 0.25 * static_cast(j1 * (j1 + 2)); + const double a2 = 0.25 * static_cast(j2 * (j2 + 2)); + return ( + (a2 - static_cast(l2 * (l2 + 1)) + 0.750) / + (a1 - static_cast(l1 * (l1 + 1)) + 0.750)) * + ((a1 + a2 - static_cast(l * (l + 1))) / (2.0 * a2)); + } + + [[nodiscard]] std::pair> propagate_cascade( + detail::KernelState& cfg) const { + // The kernel keeps the original one-based workspace layout to preserve + // the validated cascade-update order while expressing it in explicit + // C++ containers instead of the monolithic runner entry point. + std::vector popt(4, 0.0); + const std::vector pop1 = cfg.pop; + std::vector pop2(7, 0.0); + popt[1] = 2.0 * cfg.pop[1]; + popt[2] = 2.0 * cfg.pop[2] + 6.0 * cfg.pop[3]; + popt[3] = 2.0 * cfg.pop[4] + 6.0 * cfg.pop[5] + 10.0 * cfg.pop[6]; + pop2[1] = pop1[1]; + pop2[2] = (popt[2] <= 1.0e-20) ? 1.0 : 1.0 / popt[2]; + pop2[3] = (popt[2] <= 1.0e-20) ? 1.0 : 1.0 / popt[2]; + pop2[4] = (popt[3] <= 1.0e-20) ? 1.0 : 1.0 / popt[3]; + pop2[5] = (popt[3] <= 1.0e-20) ? 1.0 : 1.0 / popt[3]; + pop2[6] = (popt[3] <= 1.0e-20) ? 1.0 : 1.0 / popt[3]; + + const int ms = 3; + const double rk = cfg.widthk / cfg.hbar; + const int nu = cfg.nmax * (cfg.nmax + 1) / 2; + std::vector pnl(nu + 1, 0.0); + std::vector polpos(nu + 1, 0.0); + std::vector polneg(nu + 1, 0.0); + std::vector width(nu + 1, 0.0); + std::vector convc(nu + 1, 0.0); + std::vector sporb(nu + 1, 0.0); + std::vector pc0(nu + 1, 0.0); + std::vector pc1(nu + 1, 0.0); + std::vector pc2(nu + 1, 0.0); + std::vector> pc(ms + 1, std::vector(nu + 1, 0.0)); + const int mu = cfg.nmax * (cfg.nmax - 1) / 2; + + for (int j = 1; j <= nu; ++j) { + if (cfg.ip8 != 0) { + pnl[j] = cfg.pln[j]; + } + } + for (int j = 1; j <= cfg.nmax; ++j) { + const int jj = mu + j; + if (cfg.ip8 == 0) { + pnl[jj] = cfg.pl[j]; + } + pc1[jj] = 2.0 - 2.0 * cfg.pop[1]; + pc2[jj] = 2.0 * cfg.pop[1] - 1.0; + if (cfg.pop[1] <= 0.5) { + pc0[jj] = 1.0 - 2.0 * cfg.pop[1]; + pc1[jj] = 2.0 * cfg.pop[1]; + pc2[jj] = 0.0; + } + if (pnl[jj] > 1.0e-20) { + polpos[jj] = (1.0 + 2.0 / static_cast(2 * j - 1)) / 3.0; + } + if (pnl[jj] > 1.0e-20 && j != 1) { + polneg[jj] = (1.0 - 2.0 / static_cast(2 * j - 1)) / 3.0; + } + for (int shell = 1; shell <= ms; ++shell) { + pc[shell][jj] = popt[shell]; + } + } + + double rlyman = 0.0; + std::vector zt(131, 0.0); + std::vector> zt_shell(4, std::vector(131, 0.0)); + std::vector zr(131, 0.0); + std::vector za(131, 0.0); + std::vector za0(131, 0.0); + std::vector za1(131, 0.0); + std::vector za2(131, 0.0); + for (int i1 = 1; i1 <= cfg.nmax; ++i1) { + const int n1 = cfg.nmax + 1 - i1; + for (int i2 = 1; i2 <= n1; ++i2) { + const int l1 = i2 - 1; + double rategt = 0.0; + double rate0 = 2.0 * rk; + double rate1 = rk; + double rateauger = 0.0; + double raterd = 0.0; + const int k1 = detail::state_index(n1, l1); + if (i1 > 1) { + if (pnl[k1] < 1.0e-20) { + pc[2][k1] = popt[2]; + pc[3][k1] = popt[3]; + pc0[k1] = 0.0; + pc1[k1] = 2.0 - 2.0 * pop2[1]; + pc2[k1] = 2.0 * pop2[1] - 1.0; + if (pop2[1] < 0.5) { + pc0[k1] = 1.0 - 2.0 * pop2[1]; + pc1[k1] = 2.0 * pop2[1]; + pc2[k1] = 0.0; + } + pc[1][k1] = pc1[k1] + 2.0 * pc2[k1]; + } else { + const double xnorm = 1.0 / pnl[k1]; + pc0[k1] *= xnorm; + pc1[k1] *= xnorm; + pc2[k1] *= xnorm; + for (int shell = 2; shell <= ms; ++shell) { + pc[shell][k1] = std::max(pc[shell][k1] * xnorm, 0.0); + } + pc[1][k1] = pc1[k1] + 2.0 * pc2[k1]; + pc[1][k1] = std::min(std::max(pc[1][k1], 0.0), 2.0); + for (int shell = 1; shell <= ms; ++shell) { + if (cfg.ipc[shell] != 0) { + pc[shell][k1] = popt[shell]; + } + } + if (cfg.ipc[1] != 0) { + pc2[k1] = 2.0 * pop1[1] - 1.0; + pc1[k1] = 2.0 - 2.0 * pop1[1]; + pc0[k1] = 0.0; + if (pop1[1] < 0.5) { + pc2[k1] = 0.0; + pc1[k1] = 2.0 * pop1[1]; + pc0[k1] = 1.0 - 2.0 * pop1[1]; + } + } + polpos[k1] = polpos[k1] * xnorm * static_cast(2 * l1 + 1) / + static_cast(l1 + 1); + if (cfg.npol[n1] - l1 == 0 || cfg.npol[n1] - l1 == 1) { + polpos[k1] = (1.0 + 2.0 / static_cast(2 * l1 + 1)) / 3.0; + } + if (l1 > 0) { + polneg[k1] = polneg[k1] * xnorm * static_cast(2 * l1 + 1) / + static_cast(l1); + if (cfg.npol[n1] - l1 == 0 || cfg.npol[n1] - l1 == 1) { + polneg[k1] = (1.0 - 2.0 / static_cast(2 * l1 + 1)) / 3.0; + } + } + } + } + if (n1 == 1) { + continue; + } + double pc012 = pc0[k1] + pc1[k1] + pc2[k1]; + if (std::abs(pc012) < 1.0e-20) { + pc012 = 1.0; + } + pc0[k1] /= pc012; + pc1[k1] /= pc012; + pc2[k1] /= pc012; + + cfg.pop[1] = 0.5 * pc[1][k1]; + cfg.pop[2] = pop2[2] * pc[2][k1]; + cfg.pop[3] = pop2[3] * pc[2][k1]; + cfg.pop[4] = pop2[4] * pc[3][k1]; + cfg.pop[5] = pop2[5] * pc[3][k1]; + cfg.pop[6] = pop2[6] * pc[3][k1]; + std::fill(zt.begin(), zt.end(), 0.0); + for (auto& shell : zt_shell) { + std::fill(shell.begin(), shell.end(), 0.0); + } + std::fill(zr.begin(), zr.end(), 0.0); + std::fill(za.begin(), za.end(), 0.0); + std::fill(za0.begin(), za0.end(), 0.0); + std::fill(za1.begin(), za1.end(), 0.0); + std::fill(za2.begin(), za2.end(), 0.0); + + int k = 0; + for (int i3 = 1; i3 <= 7; ++i3) { + const int l2 = l1 - 4 + i3; + if (l2 < 0) { + continue; + } + for (int i4 = 1; i4 <= n1; ++i4) { + const int n2 = n1 - i4 + 1; + if (n2 <= l2) { + continue; + } + if (n2 == n1 && (n2 != 2 || l1 != 0 || l2 != 1)) { + continue; + } + if (n1 == n2 && cfg.espm <= 1.0e-20) { + continue; + } + k += 1; + if (n1 == n2) { + cfg.ijk = 1; + cfg.energ = cfg.espm; + } else { + cfg.ijk = 0; + } + const double popq = cfg.pop[1]; + cfg.pop[1] = 1.0; + zt[k] = primitives_.transition_rate(cfg, n1, l1, n2, l2) + 1.0e-10; + rategt += zt[k]; + if (cfg.pop[1] < 1.0e-20) { + cfg.pop[1] = 1.0; + } + cfg.rsa[1] = cfg.rsa[1] / cfg.pop[1]; + cfg.pop[1] = popq; + zr[k] = cfg.rad; + raterd += cfg.rad; + za[k] = cfg.rsa[1]; + // `rad_to_auger` used to reconstruct the effective Auger + // width from `effective_total - radiative`, which loses + // several digits when the state is almost purely + // radiative. Accumulating the Auger contribution directly + // keeps the same physics while avoiding that cancellation. + const double transition_auger = cfg.rau + 1.0e-10; + rateauger += + pc2[k1] * transition_auger + + pc1[k1] * (transition_auger - 0.5 * za[k]) + + pc0[k1] * (transition_auger - za[k]); + const double xr = zt[k] - cfg.rsa[1]; + double t0 = xr + 0.5 * cfg.rsa[1] + rk; + double g0 = xr + 2.0 * rk + 1.0e-10; + rate1 = rate1 + t0 - rk + 1.0e-10; + rate0 = rate0 + xr + 1.0e-10; + double xm = zt[k] - za[k] * (pc0[k1] + 0.5 * pc1[k1]); + if (std::abs(xm) < 1.0e-10) { + xm = 1.0; + } + if (std::abs(t0) < 1.0e-10) { + t0 = 1.0; + } + if (std::abs(g0) < 1.0e-10) { + g0 = 1.0; + } + if (std::abs(zt[k]) < 1.0e-10) { + zt[k] = 1.0; + } + zt_shell[3][k] = pc[3][k1] - cfg.rsa[3] / xm; + if (zt_shell[3][k] < 0.0) { + zt_shell[3][k] = 0.0; + } + za2[k] = xr / zt[k] * + (pc2[k1] + rk * pc1[k1] / t0 + 2.0 * rk * rk * pc0[k1] / t0 / g0); + za1[k] = za[k] * pc2[k1] / zt[k] + + (xr + rk * za[k] / zt[k]) / t0 * + (pc1[k1] + 2.0 * rk * pc0[k1] / g0); + za0[k] = pc1[k1] * za[k] / (2.0 * t0) + + pc0[k1] / g0 * (xr + rk * za[k] / t0); + const double ym = za[k] * ( + pc2[k1] / zt[k] + + pc1[k1] * (0.5 + rk / zt[k]) / t0 + + pc0[k1] * rk / t0 / g0 * (1.0 + 2.0 * rk / zt[k])); + const double xl = + rk * (pc1[k1] / t0 + 2.0 * pc0[k1] / t0 / g0 * (t0 + rk)); + zt_shell[1][k] = pc[1][k1] - ym + xl; + zt_shell[2][k] = pc[2][k1] - cfg.rsa[2] / xm - xl; + if (zt_shell[1][k] < 0.0) { + zt_shell[1][k] = 0.0; + } + if (zt_shell[2][k] < 0.0) { + zt_shell[2][k] = 0.0; + } + } + } + + width[k1] = (rategt * pc2[k1] + (rate1 - rk) * pc1[k1] + + (rate0 - 2.0 * rk) * pc0[k1]) * + cfg.hbar; + if (width[k1] < 0.0) { + width[k1] = 0.0; + } + if (std::abs(rate0) < 1.0e-10) { + rate0 = 1.0; + } + if (std::abs(rate1) < 1.0e-10) { + rate1 = 1.0; + } + if (std::abs(rategt) < 1.0e-10) { + rategt = 1.0; + } + convc[k1] = raterd / (rateauger + 1.0e-10); + if (convc[k1] < 0.0) { + convc[k1] = 9.999e99; + } + if (l1 != 0) { + sporb[k1] = 0.150 * std::pow(cfg.z, 4) / + static_cast(n1 * n1 * n1 * l1 * (l1 + 1)); + } + + k = 0; + for (int i3 = 1; i3 <= 7; ++i3) { + const int l2 = l1 - 4 + i3; + if (l2 < 0) { + continue; + } + for (int i4 = 1; i4 <= n1; ++i4) { + const int n2 = n1 - i4 + 1; + if (n2 <= l2) { + continue; + } + if (n2 == n1 && (n2 != 2 || l1 != 0 || l2 != 1)) { + continue; + } + if (n2 == n1 && cfg.espm <= 1.0e-20) { + continue; + } + k += 1; + const int k2 = detail::state_index(n2, l2); + const double bnorm = pnl[k1] * ( + pc2[k1] * zt[k] / rategt + + pc1[k1] * + (zt[k] - 0.5 * za[k] + rk * zt[k] / rategt) / rate1 + + pc0[k1] * + (zt[k] - za[k] + 2.0 * rk / rate1 * + (zt[k] - 0.5 * za[k] + rk * zt[k] / rategt)) / + rate0); + for (int shell = 1; shell <= ms; ++shell) { + pc[shell][k2] += zt_shell[shell][k] * bnorm; + } + pnl[k2] += bnorm; + pc2[k2] += za2[k] * bnorm; + pc1[k2] += za1[k] * bnorm; + pc0[k2] += za0[k] * bnorm; + + const double radint = + pnl[k1] * zr[k] * + (pc2[k1] / rategt + + pc1[k1] * (1.0 + rk / rategt) / rate1 + + pc0[k1] * + (1.0 + 2.0 * rk / rate1 * (1.0 + rk / rategt)) / + rate0); + const int ll = std::abs(l1 - l2); + const auto p = popj(l1, l2, ll); + if (cfg.ipol == 0) { + const int li = ll + 1; + const int j1u = 2 * l1 + 1; + const int j2u = 2 * l2 + 1; + const int j1d = j1u - 2; + const int j2d = j2u - 2; + if (li <= 1) { + polpos[k2] += bnorm * p[1] * polpos[k1]; + polneg[k2] += bnorm * p[2] * polneg[k1]; + } else if (l2 <= l1) { + polpos[k2] += + bnorm * + (p[1] * polpos[k1] * beta(l1, j1u, l2, j2u, ll) + + p[2] * polneg[k1] * beta(l1, j1d, l2, j2u, ll)); + if (j1d != -1 && j2d != -1) { + polneg[k2] += + bnorm * p[3] * polneg[k1] * + beta(l1, j1d, l2, j2d, ll); + } + } else { + polpos[k2] += + bnorm * p[1] * polpos[k1] * + beta(l1, j1u, l2, j2u, ll); + polneg[k2] += + bnorm * + (p[2] * polpos[k1] * beta(l1, j1u, l2, j2d, ll) + + p[3] * polneg[k1] * beta(l1, j1d, l2, j2d, ll)); + } + } + const int li = (ll != 0) ? ll : 2; + detail::record_lines(cfg, n1, l1, n2, l2, li, radint); + if (l1 == 1 && l2 == 0 && n2 == 1) { + rlyman += radint; + } + } + } + } + } + + std::vector states; + states.reserve(static_cast(cfg.nmax * (cfg.nmax + 1) / 2)); + pc[1][1] = pc1[1] + 2.0 * pc2[1]; + for (int m1 = 1; m1 <= cfg.nmax; ++m1) { + const int n1 = cfg.nmax + 1 - m1; + for (int ll1 = 1; ll1 <= n1; ++ll1) { + const int l1 = ll1 - 1; + const int k1 = detail::state_index(n1, l1); + std::optional polar_down; + if (l1 > 0) { + polar_down = + -polneg[k1] * (static_cast(l1) + 0.5) / + (static_cast(l1) - 0.5); + } + std::optional polar_up = + (cfg.ipol == 1) ? std::optional{} : std::optional{polpos[k1]}; + std::optional width_ev = + (n1 == 1 || (l1 == 0 && pnl[k1] > 1.0e-20)) + ? std::optional{} + : std::optional{width[k1]}; + std::optional rad_to_auger = + (n1 == 1 || (l1 == 0 && pnl[k1] > 1.0e-20)) + ? std::optional{} + : std::optional{convc[k1]}; + std::optional spin_orbit_ev = + (cfg.ipol == 1 || n1 == 1 || (l1 == 0 && pnl[k1] > 1.0e-20)) + ? std::optional{} + : std::optional{sporb[k1]}; + states.push_back(StateSummary{ + n1, + l1, + pnl[k1], + polar_up, + polar_down, + width_ev, + rad_to_auger, + spin_orbit_ev, + pc[1][k1], + pc[2][k1], + pc[3][k1], + }); + } + } + for (int i = 1; i <= 6; ++i) { + cfg.pop[i] = pop1[i]; + } + return {rlyman, std::move(states)}; + } + + SimulationConfig config_; + detail::NumericTables tables_; + detail::PhysicsEngine primitives_; +}; + +ModernCascadeKernel::ModernCascadeKernel(const SimulationConfig& config) + : impl_(std::make_unique(config)) {} + +ModernCascadeKernel::~ModernCascadeKernel() = default; + +ModernCascadeKernel::ModernCascadeKernel(ModernCascadeKernel&&) noexcept = default; + +ModernCascadeKernel& ModernCascadeKernel::operator=(ModernCascadeKernel&&) noexcept = default; + +SimulationResult ModernCascadeKernel::run() const { + return impl_->run(); +} + +SimulationResult run_modern_kernel(const SimulationConfig& config) { + return ModernCascadeKernel(config).run(); +} + +} // namespace mocca diff --git a/src/line_codec.cpp b/src/line_codec.cpp new file mode 100644 index 0000000..e556346 --- /dev/null +++ b/src/line_codec.cpp @@ -0,0 +1,440 @@ +#include "line_codec.hpp" + +#include +#include +#include +#include +#include + +namespace mocca::detail { + +namespace { + +constexpr int kN1Shift = 0; +constexpr int kL1Shift = 5; +constexpr int kJ1Shift = 10; +constexpr int kN2Shift = 16; +constexpr int kL2Shift = 21; +constexpr int kJ2Shift = 26; +constexpr int kMultipoleShift = 32; + +constexpr std::int64_t kFiveBitMask = 0x1FLL; +constexpr std::int64_t kSixBitMask = 0x3FLL; +constexpr std::int64_t kThreeBitMask = 0x7LL; + +int lower_twice_j(int l) { + return l == 0 ? 1 : 2 * l - 1; +} + +int upper_twice_j(int l) { + return l == 0 ? 1 : 2 * l + 1; +} + +std::int64_t pack_line_id( + int n1, + int l1, + int j1_twice, + int n2, + int l2, + int j2_twice, + int multipole) { + const auto fits_mask = [](int value, std::int64_t mask) { + return value >= 0 && static_cast(value) <= mask; + }; + if (!fits_mask(n1, kFiveBitMask) || !fits_mask(l1, kFiveBitMask) || + !fits_mask(j1_twice, kSixBitMask) || !fits_mask(n2, kFiveBitMask) || + !fits_mask(l2, kFiveBitMask) || !fits_mask(j2_twice, kSixBitMask) || + !fits_mask(multipole, kThreeBitMask)) { + throw std::runtime_error("Line descriptor exceeds the supported packed range"); + } + return (static_cast(n1) << kN1Shift) | + (static_cast(l1) << kL1Shift) | + (static_cast(j1_twice) << kJ1Shift) | + (static_cast(n2) << kN2Shift) | + (static_cast(l2) << kL2Shift) | + (static_cast(j2_twice) << kJ2Shift) | + (static_cast(multipole) << kMultipoleShift); +} + +void store_line( + KernelState& cfg, + int index, + double energy, + int n1, + int l1, + int j1_twice, + int n2, + int l2, + int j2_twice, + int multipole, + double intensity) { + cfg.line_e[index] = energy; + cfg.line_ia[index] = pack_line_id(n1, l1, j1_twice, n2, l2, j2_twice, multipole); + cfg.line_ai[index] = intensity; +} + +std::string multipole_name(int multipole) { + switch (multipole) { + case 1: + return "DIP"; + case 2: + return "QUA"; + case 3: + return "OCT"; + default: + throw std::runtime_error("Invalid packed multipole id"); + } +} + +} // namespace + +void record_lines( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int multipole, + double intensity) { + if (intensity <= cfg.climit) { + return; + } + if (cfg.m > 995) { + const std::string warning = + "*** ATTENTION *** OVERFLOWING CAPABILITY OF SORTING *** PLEASE RESTRICT CRITERIA FOR LINES TO PASS ***"; + if (std::find(cfg.warnings.begin(), cfg.warnings.end(), warning) == cfg.warnings.end()) { + cfg.warnings.push_back(warning); + } + return; + } + + double e12 = 0.0; + double e22 = 0.0; + double e11 = cfg.energy[n1][2 * l1 + 1]; + if (l1 != 0) { + e12 = cfg.energy[n1][2 * l1]; + } + double e21 = cfg.energy[n2][2 * l2 + 1]; + if (l2 != 0) { + e22 = cfg.energy[n2][2 * l2]; + } + if (n1 != n2 && (e21 - e11 <= cfg.elow || e21 - e11 >= cfg.ehigh)) { + return; + } + if (n1 == n2) { + e11 = 0.0; + const double ez = 0.5 * (cfg.energy[2][2] - cfg.energy[2][3]); + e21 = cfg.esp * 1.0e-6 - ez; + e22 = e21 + 2.0 * ez; + } + + if (multipole == 1) { + const int ll = std::max(l1, l2); + const double an = intensity / static_cast(4 * ll * ll - 1); + store_line( + cfg, + cfg.m, + e21 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + an * static_cast((ll + 1) * (2 * ll - 1))); + store_line( + cfg, + cfg.m + 1, + l1 == ll ? e21 - e12 : e22 - e11, + n1, + l1, + l1 == ll ? lower_twice_j(l1) : upper_twice_j(l1), + n2, + l2, + l1 == ll ? upper_twice_j(l2) : lower_twice_j(l2), + multipole, + an); + store_line( + cfg, + cfg.m + 2, + e22 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + an * static_cast((ll - 1) * (2 * ll + 1))); + cfg.m += 3; + if (ll == 1) { + cfg.m -= 1; + } + return; + } + + if (multipole == 2) { + if (l1 != l2) { + const int ll = std::max(l1, l2); + const double an = intensity / static_cast((2 * ll - 3) * (2 * ll + 1)); + store_line( + cfg, + cfg.m, + e21 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + an * static_cast((ll + 1) * (2 * ll - 3))); + store_line( + cfg, + cfg.m + 1, + l1 == ll ? e21 - e12 : e22 - e11, + n1, + l1, + l1 == ll ? lower_twice_j(l1) : upper_twice_j(l1), + n2, + l2, + l1 == ll ? upper_twice_j(l2) : lower_twice_j(l2), + multipole, + 2.0 * an); + store_line( + cfg, + cfg.m + 2, + e22 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + an * static_cast((ll - 2) * (2 * ll + 1))); + cfg.m += 3; + if (ll <= 2) { + cfg.m -= 1; + } + return; + } + if (l1 == 0) { + return; + } + const double an = intensity / static_cast((2 * l1 + 1) * (2 * l1 + 1)); + store_line( + cfg, + cfg.m, + e21 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + an * static_cast((l1 + 2) * (2 * l1 - 1))); + store_line( + cfg, + cfg.m + 1, + e22 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + 3.0 * an); + store_line( + cfg, + cfg.m + 2, + e21 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + 3.0 * an); + store_line( + cfg, + cfg.m + 3, + e22 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + an * static_cast((l1 - 1) * (2 * l1 + 3))); + cfg.m += 4; + if (l1 == 1) { + cfg.m -= 1; + } + return; + } + + if (std::abs(l1 - l2) != 1) { + const int ll = std::max(l1, l2); + const double an = intensity / static_cast((2 * ll - 5) * (2 * ll + 1)); + store_line( + cfg, + cfg.m, + e21 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + an * static_cast((2 * ll - 5) * (ll + 1))); + store_line( + cfg, + cfg.m + 1, + l1 == ll ? e21 - e12 : e22 - e11, + n1, + l1, + l1 == ll ? lower_twice_j(l1) : upper_twice_j(l1), + n2, + l2, + l1 == ll ? upper_twice_j(l2) : lower_twice_j(l2), + multipole, + 3.0 * an); + store_line( + cfg, + cfg.m + 2, + e22 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + an * static_cast((2 * ll + 1) * (ll - 3))); + cfg.m += 3; + if (ll <= 3) { + cfg.m -= 1; + } + return; + } + + const int ll = std::max(l1, l2); + const double an = intensity / static_cast(4 * ll * ll - 1); + store_line( + cfg, + cfg.m, + e21 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + an * static_cast((2 * ll - 3) * (ll + 2))); + store_line( + cfg, + cfg.m + 1, + e22 - e11, + n1, + l1, + upper_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + 5.0 * an); + store_line( + cfg, + cfg.m + 2, + e21 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + upper_twice_j(l2), + multipole, + 6.0 * an); + store_line( + cfg, + cfg.m + 3, + e22 - e12, + n1, + l1, + lower_twice_j(l1), + n2, + l2, + lower_twice_j(l2), + multipole, + an * static_cast((2 * ll + 3) * (ll - 2))); + cfg.m += 4; + if (ll <= 2) { + cfg.m -= 1; + } +} + +std::vector collect_lines(const KernelState& cfg) { + std::vector lines; + lines.reserve(cfg.m > 1 ? static_cast(cfg.m - 1) : 0); + for (int i = 1; i < cfg.m; ++i) { + if (!std::isfinite(cfg.line_ai[i]) || !std::isfinite(cfg.line_e[i])) { + continue; + } + if (cfg.line_ai[i] <= cfg.climit) { + continue; + } + const std::int64_t ia0 = cfg.line_ia[i]; + const int n1 = static_cast((ia0 >> kN1Shift) & kFiveBitMask); + const int l1 = static_cast((ia0 >> kL1Shift) & kFiveBitMask); + const int j1 = static_cast((ia0 >> kJ1Shift) & kSixBitMask); + const int n2 = static_cast((ia0 >> kN2Shift) & kFiveBitMask); + const int l2 = static_cast((ia0 >> kL2Shift) & kFiveBitMask); + const int j2 = static_cast((ia0 >> kJ2Shift) & kSixBitMask); + const int multipole_id = static_cast((ia0 >> kMultipoleShift) & kThreeBitMask); + lines.push_back(TransitionLine{ + n1, + l1, + j1, + n2, + l2, + j2, + multipole_name(multipole_id), + 1000.0 * cfg.line_e[i], + cfg.line_ai[i], + }); + } + + std::sort(lines.begin(), lines.end(), [](const TransitionLine& lhs, const TransitionLine& rhs) { + return std::tie( + lhs.energy_kev, + lhs.n1, + lhs.l1, + lhs.j1_twice, + lhs.n2, + lhs.l2, + lhs.j2_twice, + lhs.multipole, + lhs.intensity) < + std::tie( + rhs.energy_kev, + rhs.n1, + rhs.l1, + rhs.j1_twice, + rhs.n2, + rhs.l2, + rhs.j2_twice, + rhs.multipole, + rhs.intensity); + }); + return lines; +} + +} // namespace mocca::detail diff --git a/src/line_codec.hpp b/src/line_codec.hpp new file mode 100644 index 0000000..7892fce --- /dev/null +++ b/src/line_codec.hpp @@ -0,0 +1,21 @@ +#pragma once + +#include "mocca/api.hpp" +#include "physics_engine.hpp" + +#include + +namespace mocca::detail { + +void record_lines( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int multipole, + double intensity); + +[[nodiscard]] std::vector collect_lines(const KernelState& cfg); + +} // namespace mocca::detail diff --git a/src/physics_engine.cpp b/src/physics_engine.cpp new file mode 100644 index 0000000..1b1f25f --- /dev/null +++ b/src/physics_engine.cpp @@ -0,0 +1,1851 @@ +#include "physics_engine.hpp" + +#include "embedded_tables.hpp" + +#include +#include +#include +#include +#include +#include +#include +#include + +namespace mocca::detail { + +namespace { + +template +std::vector one_based(const std::vector& values, std::size_t size = 0, T fill = T()) { + std::vector result; + result.reserve((size != 0 ? size : values.size()) + 1); + result.push_back(fill); + result.insert(result.end(), values.begin(), values.end()); + if (size != 0 && values.size() < size) { + result.resize(size + 1, fill); + } + return result; +} + +std::vector> new_energy_table() { + return std::vector>(21, std::vector(41, 0.0)); +} + +std::vector new_line_buffer_float() { + return std::vector(1001, 0.0); +} + +std::vector new_line_buffer_int() { + return std::vector(1001, 0); +} + +std::string trim_right(std::string value) { + while (!value.empty() && + (value.back() == '\n' || value.back() == '\r' || + std::isspace(static_cast(value.back())))) { + value.pop_back(); + } + return value; +} + +std::string trim_copy(std::string value) { + std::size_t start = 0; + while (start < value.size() && + std::isspace(static_cast(value[start])) != 0) { + ++start; + } + value.erase(0, start); + return trim_right(std::move(value)); +} + +WideFloat mpf_from_double(double value, unsigned long precision_bits) { + std::ostringstream out; + out << std::setprecision(std::numeric_limits::max_digits10) << value; + return WideFloat(out.str(), precision_bits); +} + +WideFloat mpf_powi(WideFloat base, int exponent) { + if (exponent == 0) { + return WideFloat(1); + } + if (exponent < 0) { + return WideFloat(1) / mpf_powi(base, -exponent); + } + WideFloat result(1); + while (exponent > 0) { + if ((exponent & 1) != 0) { + result *= base; + } + exponent >>= 1; + if (exponent != 0) { + base *= base; + } + } + return result; +} + +unsigned long decimal_digits_to_bits(int digits) { + return static_cast( + std::ceil(static_cast(digits) * 3.3219280948873626 + 32.0)); +} + +WideFloat stable_sum(std::vector terms, unsigned long precision_bits) { + std::sort(terms.begin(), terms.end(), [](const WideFloat& lhs, const WideFloat& rhs) { + return abs(lhs) < abs(rhs); + }); + WideFloat total(0, precision_bits); + for (const auto& term : terms) { + total += term; + } + return total; +} + +} // namespace + +int state_index(int n, int l) { + if (n < 1 || l < 0 || l >= n) { + throw std::runtime_error("Invalid (n,l) state"); + } + const long long index = (static_cast(n) * static_cast(n - 1)) / 2 + + static_cast(l) + 1; + if (index > std::numeric_limits::max()) { + throw std::runtime_error("State index exceeds supported integer range"); + } + return static_cast(index); +} + +KernelState::KernelState(const NumericTables& numeric_tables) + : bem(one_based({0.0, 0.0, 0.0}, 3, 0.0)), + zsa(one_based({0.0, 0.0, 0.0}, 3, 0.0)), + be(one_based({0.0, 0.0, 0.0}, 3, 0.0)), + nn0(one_based({1, 2, 3}, 3, 0)), + nn1(one_based({0, 1, 2, 3, 3, 3, 3}, 7, 0)), + nn2(one_based({0, 1, 2, 3, 3, 3, 3}, 7, 0)), + nn3(one_based({0, 1, 2, 3, 3, 3, 3}, 7, 0)), + r0(one_based({0.0, 0.0, 0.0}, 3, 0.0)), + r1(one_based(std::vector(7, 0.0), 7, 0.0)), + r2(one_based(std::vector(7, 0.0), 7, 0.0)), + r3(one_based(std::vector(7, 0.0), 7, 0.0)), + ip1(one_based({0, 1, 1, 1, 1, 1, 1}, 7, 0)), + ip2(one_based({0, 1, 1, 1, 1, 1, 1}, 7, 0)), + ip3(one_based({0, 1, 1, 1, 1, 1, 1}, 7, 0)), + iq1(one_based(std::vector(7, 0), 7, 0)), + iq2(one_based(std::vector(7, 0), 7, 0)), + iq3(one_based(std::vector(7, 0), 7, 0)), + f(one_based(std::vector(60, 0.0), 60, 0.0)), + ne(one_based({0, 2, 2}, 3, 0)), + jk(one_based({0, 2, 3}, 3, 0)), + amzz(one_based({0.0, 0.0, 0.0}, 3, 0.0)), + expmon(), + expdip(), + expqua(), + expoct(), + coemon(), + coedip(), + coequa(), + coeoct(), + ifm(one_based(std::vector(6, 0), 6, 0)), + ifd(one_based(std::vector(9, 0), 9, 0)), + ifq(one_based(std::vector(10, 0), 10, 0)), + ifo(one_based(std::vector(10, 0), 10, 0)), + coedp(), + coeq(), + coeo(), + coed(), + ll(one_based([] { + std::vector values(20); + for (int i = 0; i < 20; ++i) { + values[i] = i; + } + return values; + }(), 20, 0)), + m1(one_based({0, 0, 0, 0, 1, 2, 3}, 7, 0)), + m2(one_based({0, 0, 0, 0, 1, 2, 3}, 7, 0)), + m3(one_based({0, 0, 0, 0, 1, 2, 3}, 7, 0)), + yc(one_based({1.0, 1.0, 1.0, 1.0}, 4, 0.0)), + rr(one_based(std::vector(18, 0.0), 18, 0.0)), + ra(one_based(std::vector(4, 0.0), 4, 0.0)), + rd(one_based(std::vector(4, 0.0), 4, 0.0)), + rsa(one_based(std::vector(4, 0.0), 4, 0.0)), + pop(one_based(std::vector(6, 1.0), 6, 0.0)), + jtm(one_based(std::vector(6, 1), 6, 0)), + jtd(one_based(std::vector(6, 1), 6, 0)), + jtq(one_based(std::vector(6, 1), 6, 0)), + jto(one_based(std::vector(6, 1), 6, 0)), + jm(one_based(std::vector(10, 1), 10, 0)), + jd(one_based(std::vector(14, 1), 14, 0)), + jq(one_based(std::vector(15, 1), 15, 0)), + jo(one_based(std::vector(15, 1), 15, 0)), + ij(one_based({1, 1, 1, 1}, 4, 0)), + yj(one_based({0.0, 0.0, 0.0, 0.0}, 4, 0.0)), + jj1(one_based({1, 1, 1, 1}, 4, 0)), + line_e(new_line_buffer_float()), + line_ai(new_line_buffer_float()), + line_ia(new_line_buffer_int()), + energy(new_energy_table()), + cd(one_based({1.0e-1, 1.0e-2, 1.0e-3, 1.0e-4, 1.0e-5}, 5, 0.0)), + pl(one_based(std::vector(20, 0.0), 20, 0.0)), + npol(one_based(std::vector(20, -1), 20, 0)), + pln(one_based(std::vector(210, 0.0), 210, 0.0)), + ipc(one_based({0, 0, 0}, 3, 0)) { + coedp = one_based(numeric_tables.at("COEDP"), 0, 0.0); + coeq = one_based(numeric_tables.at("COEQ"), 0, 0.0); + coeo = one_based(numeric_tables.at("COEO"), 0, 0.0); + coed = one_based(numeric_tables.at("COED"), 0, 0.0); + expmon = one_based(numeric_tables.at("EXPMON"), 0, 0.0); + expdip = one_based(numeric_tables.at("EXPDIP"), 0, 0.0); + expqua = one_based(numeric_tables.at("EXPQUA"), 0, 0.0); + expoct = one_based(numeric_tables.at("EXPOCT"), 0, 0.0); + coemon = one_based(numeric_tables.at("COEMON"), 0, 0.0); + coedip = one_based(numeric_tables.at("COEDIP"), 0, 0.0); + coequa = one_based(numeric_tables.at("COEQUA"), 0, 0.0); + coeoct = one_based(numeric_tables.at("COEOCT"), 0, 0.0); +} + +NumericTables load_numeric_tables(const std::filesystem::path& fortran_path) { + const auto lines = [&]() { + std::ifstream input(fortran_path); + if (!input) { + throw std::runtime_error("Unable to open Fortran source: " + fortran_path.string()); + } + std::vector values; + std::string line; + while (std::getline(input, line)) { + values.push_back(line); + } + return values; + }(); + + std::vector logical_lines; + std::string current; + bool in_block_data = false; + for (const auto& raw_line : lines) { + if (raw_line.find("BLOCK DATA") != std::string::npos) { + in_block_data = true; + } + if (!in_block_data) { + continue; + } + if (raw_line.empty()) { + continue; + } + if (raw_line[0] == 'C' || raw_line[0] == 'c' || raw_line[0] == '*') { + continue; + } + std::string padded = raw_line; + if (padded.size() < 6) { + padded.resize(6, ' '); + } + const bool continuation = padded[5] != ' ' && padded[5] != '0'; + const std::string payload = + trim_right(padded.size() > 6 ? padded.substr(6) : std::string()); + if (!continuation) { + if (!current.empty()) { + logical_lines.push_back(current); + } + current = payload; + } else { + current += " " + payload; + } + } + if (!current.empty()) { + logical_lines.push_back(current); + } + + const std::vector names = { + "COEDP", "COEQ", "COEO", "COED", "EXPMON", "EXPDIP", + "EXPQUA", "EXPOCT", "COEMON", "COEDIP", "COEQUA", "COEOCT", + }; + NumericTables tables; + for (const auto& logical_line : logical_lines) { + std::string text; + bool previous_space = false; + for (char ch : logical_line) { + const bool is_space = std::isspace(static_cast(ch)) != 0; + if (is_space) { + if (!previous_space) { + text.push_back(' '); + } + } else { + text.push_back(ch); + } + previous_space = is_space; + } + text = trim_copy(std::move(text)); + if (!text.starts_with("DATA ")) { + continue; + } + for (const auto& name : names) { + const std::string marker = "DATA " + name + "/"; + const auto marker_pos = text.find(marker); + if (marker_pos == std::string::npos) { + continue; + } + auto payload = text.substr(marker_pos + marker.size()); + const auto slash = payload.rfind('/'); + if (slash == std::string::npos) { + break; + } + payload = payload.substr(0, slash); + std::vector values; + std::stringstream split(payload); + std::string token; + while (std::getline(split, token, ',')) { + token = trim_right(token); + std::size_t start = 0; + while (start < token.size() && + std::isspace(static_cast(token[start])) != 0) { + ++start; + } + token = token.substr(start); + if (token.empty()) { + continue; + } + int repeat = 1; + const auto star = token.find('*'); + if (star != std::string::npos) { + const auto left = token.substr(0, star); + const auto right = token.substr(star + 1); + if (!left.empty() && + std::all_of(left.begin(), left.end(), [](char ch) { + return std::isdigit(static_cast(ch)) != 0; + })) { + repeat = std::stoi(left); + token = right; + } + } + if (token.find('H') != std::string::npos) { + throw std::runtime_error( + "Unexpected Hollerith constant in numeric table " + name); + } + std::replace(token.begin(), token.end(), 'D', 'E'); + std::replace(token.begin(), token.end(), 'd', 'E'); + const double value = std::stod(token); + for (int i = 0; i < repeat; ++i) { + values.push_back(value); + } + } + tables[name] = values; + break; + } + } + const NumericTables expected_tables = bundled_numeric_tables(); + for (const auto& name : names) { + if (!tables.contains(name)) { + throw std::runtime_error( + "Failed to load numeric table " + name + " from " + fortran_path.string()); + } + const auto expected = expected_tables.find(name); + if (expected == expected_tables.end()) { + throw std::runtime_error("Bundled coefficient table reference is missing " + name); + } + if (tables.at(name).size() != expected->second.size()) { + std::ostringstream out; + out << "Numeric table " << name << " in " << fortran_path.string() + << " has " << tables.at(name).size() << " value(s); expected " + << expected->second.size(); + throw std::runtime_error(out.str()); + } + } + return tables; +} + +PhysicsEngine::PhysicsEngine(const NumericTables& numeric_tables, int precision_digits) + : tables_(numeric_tables), + precision_digits_(precision_digits), + precision_bits_(decimal_digits_to_bits(precision_digits)) {} + +const std::vector& PhysicsEngine::factor_table(double fd) const { + if (!std::isfinite(fd) || fd <= 0.0) { + throw std::runtime_error("model.factorial_divider must be finite and strictly positive"); + } + + static thread_local double cached_factor_fd = std::numeric_limits::quiet_NaN(); + static thread_local unsigned long cached_precision_bits = 0; + static thread_local std::vector cached_factors; + if (!cached_factors.empty() && cached_precision_bits == precision_bits_ && + std::abs(cached_factor_fd - fd) <= 1.0e-20) { + return cached_factors; + } + + cached_factor_fd = fd; + cached_precision_bits = precision_bits_; + cached_factors.assign(61, WideFloat(0, precision_bits_)); + cached_factors[1] = WideFloat(1, precision_bits_); + const WideFloat dfd = mpf_from_double(fd, precision_bits_); + for (int index = 2; index <= 60; ++index) { + cached_factors[index] = + cached_factors[index - 1] * WideFloat(index - 1, precision_bits_) / dfd; + } + return cached_factors; +} + +double PhysicsEngine::powi(double base, int exponent) const { + if (exponent == 0) { + return 1.0; + } + return std::pow(base, exponent); +} + +double PhysicsEngine::continuum_extpy(double y) const { + return 1.0 / (-std::expm1(-2.0 * M_PI * y)); +} + +double PhysicsEngine::continuum_expiy(double y) const { + const double pi_y = M_PI * y; + return std::exp(-pi_y) / (-std::expm1(-2.0 * pi_y)); +} + +double PhysicsEngine::rmon_coeff(const KernelState& cfg, double y) const { + return cfg.picoef * 2.0 * continuum_extpy(y); +} + +void PhysicsEngine::warn(KernelState& cfg, const std::string& message) const { + cfg.warnings.push_back(message); +} + +void PhysicsEngine::apply_input_energy_defaults(KernelState& cfg) const { + for (int n = 1; n <= cfg.nmax; ++n) { + for (int lj = 1; lj < 2 * n; ++lj) { + if (cfg.energy[n][lj] <= 0.0) { + const int point_j = (lj - 1) / 2 + 1; + cfg.energy[n][lj] = point(cfg, n, point_j) - cfg.energy[n][lj]; + } + } + } +} + +void PhysicsEngine::prepare_case(KernelState& cfg) const { + cfg.m = 1; + cfg.line_e = new_line_buffer_float(); + cfg.line_ai = new_line_buffer_float(); + cfg.line_ia = new_line_buffer_int(); + ffix(cfg); + apply_input_energy_defaults(cfg); + + if (cfg.nopt == 0) { + for (int i = 1; i <= cfg.nmax; ++i) { + cfg.pl[i] = + static_cast(2 * i - 1) * std::exp(cfg.alexp * static_cast(i - 1)); + } + } + if (cfg.nopt == 2) { + for (int i = 1; i <= cfg.nmax; ++i) { + const double x = static_cast(i - 1); + cfg.pl[i] = 1.0 + cfg.cl1 * x + cfg.cl2 * (x * x); + } + } + double ss = 0.0; + for (int i = 1; i <= cfg.nmax; ++i) { + ss += cfg.pl[i]; + } + if (ss <= 0.0) { + warn(cfg, "Initial l-distribution sums to zero"); + ss = 1.0; + } + for (int i = 1; i <= cfg.nmax; ++i) { + cfg.pl[i] /= ss; + } + if (cfg.ip8 != 0) { + const int nu = cfg.nmax * (cfg.nmax + 1) / 2; + ss = 0.0; + for (int i = 1; i <= nu; ++i) { + ss += cfg.pln[i]; + } + if (ss <= 0.0) { + warn(cfg, "Extended initial l-distribution sums to zero"); + ss = 1.0; + } + for (int i = 1; i <= nu; ++i) { + cfg.pln[i] /= ss; + } + } +} + +void PhysicsEngine::ffix(KernelState& cfg) const { + cfg.f[1] = 1.0; + for (int index = 2; index <= 60; ++index) { + cfg.f[index] = cfg.f[index - 1] * static_cast(index - 1) / cfg.fd; + } + if (cfg.z <= 0.0) { + throw std::runtime_error("Z not given"); + } + if (cfg.ivers == 1) { + if (cfg.z - cfg.zsk < 0.0 || cfg.z - cfg.zsk > cfg.zmkm) { + cfg.zsk = cfg.z - cfg.zmk; + } + if (cfg.z - cfg.zsl < 0.0 || cfg.z - cfg.zsl > cfg.zmlm) { + cfg.zsl = cfg.z - cfg.zml; + } + if (cfg.z - cfg.zsm < 0.0 || cfg.z - cfg.zsm > cfg.zmmm) { + cfg.zsm = cfg.z - cfg.zmm; + } + } + cfg.zsk = std::max(cfg.zsk, 1.0); + cfg.zsl = std::max(cfg.zsl, 1.0); + cfg.zsm = std::max(cfg.zsm, 1.0); + cfg.zskz = cfg.zsk / cfg.z; + cfg.zslz = cfg.zsl / cfg.z; + cfg.zsmz = cfg.zsm / cfg.z; + cfg.amzz[1] = cfg.zskz / cfg.amassm; + cfg.amzz[2] = cfg.zslz / cfg.amassm; + cfg.amzz[3] = cfg.zsmz / cfg.amassm; + cfg.econst = cfg.econs * cfg.z * cfg.z; + for (int i = 1; i <= 3; ++i) { + cfg.bem[i] = cfg.be[i] / cfg.amasse; + } + if (cfg.bem[1] * cfg.bem[2] * cfg.bem[3] <= 1.0e-20) { + throw std::runtime_error("Binding energies are undefined"); + } + cfg.zsa[1] = cfg.zsk * cfg.alfa; + cfg.zsa[2] = cfg.zsl * cfg.alfa; + cfg.zsa[3] = cfg.zsm * cfg.alfa; + cfg.d2p1sm = cfg.d2p1s / cfg.amasse; + cfg.espm = cfg.esp / cfg.amasse; + + const double scale = default_amassm_ / cfg.amassm; + auto scale_table = [&](const std::string& name) { + std::vector values = tables_.at(name); + for (double& value : values) { + value *= scale; + } + return one_based(values, 0, 0.0); + }; + cfg.expmon = scale_table("EXPMON"); + cfg.expdip = scale_table("EXPDIP"); + cfg.expqua = scale_table("EXPQUA"); + cfg.expoct = scale_table("EXPOCT"); + + cfg.dza = cfg.z * cfg.alfa; + cfg.dza2 = cfg.dza * cfg.dza; + const double ame_mev = cfg.amasse * 1.0e-06; + cfg.dredm = + cfg.a * cfg.amassn * cfg.amassm * ame_mev / + (cfg.a * cfg.amassn + cfg.amassm * ame_mev); + if (cfg.amassa > 1.0e-20) { + const double amass_total = cfg.amassa * cfg.amassn; + cfg.dredm = amass_total * cfg.amassm * ame_mev / (amass_total + cfg.amassm * ame_mev); + } + + if (cfg.iyc != 0) { + const double ya = 0.0297 * std::pow(cfg.z, 0.666667); + const double yb = 0.0667 * std::sqrt(cfg.z); + const double yk = 0.0758 * std::sqrt(cfg.z); + const double yd = 0.0850 * std::sqrt(cfg.z); + cfg.yc[1] = std::min(cfg.yc[1], ya); + cfg.yc[2] = std::min(cfg.yc[2], yb); + cfg.yc[3] = std::min(cfg.yc[3], yk); + cfg.yc[4] = std::min(cfg.yc[4], yd); + } + if (cfg.cfm < 1.0e-20) { + cfg.cfm = 1.100 * std::pow(cfg.a, 0.333333); + } + if (cfg.amassa > 1.0e-20 && + std::abs(cfg.cfm - 1.100 * std::pow(cfg.a, 0.3333)) < 1.0e-20) { + cfg.cfm = 1.100 * std::pow(cfg.amassa, 0.333333); + } + if (cfg.d2p1s <= 1.0e-20) { + const double r1 = 1.200 * std::pow(cfg.a, 0.3333); + const double x = 2.000e-05 * cfg.z * r1 * cfg.amassm / 0.529; + cfg.d2p1sm = cfg.econst * ( + 0.750 + + 3.0 / std::pow(x, 3) * + (x * x - 4.0 - std::pow(x, 3) / 3.0 + + std::exp(-x) * (x * x + 4.0 + 4.0 * x))); + } +} + +double PhysicsEngine::point(const KernelState& cfg, int n, int j) const { + const double dn = static_cast(n); + const double dj = static_cast(j); + double value = cfg.dza / (dn - dj + std::sqrt(dj * dj - cfg.dza2)); + value = cfg.dredm / std::sqrt(1.0 + value * value); + return cfg.dredm - value; +} + +double PhysicsEngine::matel( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int l, + double a, + int n) const { + const auto make = [&](double value) { return mpf_from_double(value, precision_bits_); }; + const auto make_int = [&](long value) { return WideFloat(value, precision_bits_); }; + const std::vector& factors = factor_table(cfg.fd); + const WideFloat dfd = make(cfg.fd); + + const WideFloat an = make_int(n1 + n2); + const WideFloat p = + make_int(1) + make(1.0e-3 * a * static_cast(n1 * n2)) / an; + const WideFloat a1 = make_int(-2) * make_int(n2) / an / p; + const WideFloat a2 = make_int(-2) * make_int(n1) / an / p; + const WideFloat aq = make_int(2) / (an * p); + const int m1 = n1 - l1; + const int m2 = n2 - l2; + const int m3 = n1 + l1 + 1; + const int m4 = n2 + l2 + 1; + const int m5 = 2 * l1 + 2; + const int m6 = 2 * l2 + 2; + const int mm = l1 + l2 + l + 3; + + std::vector outer_terms; + outer_terms.reserve(m1); + for (int i1 = 1; i1 <= m1; ++i1) { + const int k1 = i1 - 1; + std::vector inner_terms; + inner_terms.reserve(m2); + for (int i2 = 1; i2 <= m2; ++i2) { + const int k2 = i2 - 1; + const int la = mm + k1 + k2; + const int lb = m2 - k2; + const int lc = m6 + k2; + inner_terms.push_back( + mpf_powi(a2, k2) * factors[la] / (factors[lb] * factors[lc] * factors[i2])); + } + const int ld = m1 - k1; + const int le = m5 + k1; + outer_terms.push_back( + stable_sum(std::move(inner_terms), precision_bits_) * mpf_powi(a1, k1) / + (factors[ld] * factors[le] * factors[i1])); + } + + const WideFloat s1 = stable_sum(std::move(outer_terms), precision_bits_); + const WideFloat aq_power = mpf_powi(aq, l - 1); + const WideFloat t1 = + s1 * sqrt(factors[m1] * factors[m2] / aq_power * factors[m3] * factors[m4]); + WideFloat value = t1 * mpf_powi(aq * make_int(n1), l + l2 + 1) * + mpf_powi(aq * make_int(n2), l + l1 + 1) * + mpf_powi(make(0.5), l + 1) * mpf_powi(dfd, l + 1) / + sqrt(aq_power); + value *= mpf_powi(make(cfg.amzz[n]), l); + return value.get_d(); +} + +double PhysicsEngine::matelu( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int l) const { + const auto make = [&](double value) { return mpf_from_double(value, precision_bits_); }; + const auto make_int = [&](long value) { return WideFloat(value, precision_bits_); }; + const std::vector& factors = factor_table(cfg.fd); + const WideFloat dfd = make(cfg.fd); + + const WideFloat an = make_int(n1 + n2); + const WideFloat a1 = make_int(-2) * make_int(n2) / an; + const WideFloat a2 = make_int(-2) * make_int(n1) / an; + const WideFloat aq = make_int(2) / an; + const int m1 = n1 - l1; + const int m2 = n2 - l2; + const int m3 = n1 + l1 + 1; + const int m4 = n2 + l2 + 1; + const int m5 = 2 * l1 + 2; + const int m6 = 2 * l2 + 2; + const int mm = l1 + l2 + l + 3; + + std::vector outer_terms; + outer_terms.reserve(m1); + for (int i1 = 1; i1 <= m1; ++i1) { + const int k1 = i1 - 1; + std::vector inner_terms; + inner_terms.reserve(m2); + for (int i2 = 1; i2 <= m2; ++i2) { + const int k2 = i2 - 1; + const int la = mm + k1 + k2; + const int lb = m2 - k2; + const int lc = m6 + k2; + inner_terms.push_back( + mpf_powi(a2, k2) * factors[la] / (factors[lb] * factors[lc] * factors[i2])); + } + const int ld = m1 - k1; + const int le = m5 + k1; + outer_terms.push_back( + stable_sum(std::move(inner_terms), precision_bits_) * mpf_powi(a1, k1) / + (factors[ld] * factors[le] * factors[i1])); + } + + const WideFloat s1 = stable_sum(std::move(outer_terms), precision_bits_); + const WideFloat aq_power = mpf_powi(aq, l - 1); + const WideFloat t1 = + s1 * sqrt(factors[m1] * factors[m2] / aq_power * factors[m3] * factors[m4]); + const WideFloat value = t1 * mpf_powi(aq * make_int(n1), l + l2 + 1) * + mpf_powi(aq * make_int(n2), l + l1 + 1) * + mpf_powi(make(0.5), l + 1) * mpf_powi(dfd, l + 1) / + sqrt(aq_power); + return value.get_d(); +} + +double PhysicsEngine::rdipu( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + double enem, + double y, + int mm) const { + if (n <= 0) { + cfg.aid = matelu(cfg, n1, l1, n2, l2, 1); + cfg.aidsq = cfg.aid * cfg.aid; + const int l = (l1 + l2 + 1) / 2; + cfg.angd = static_cast((2 * l2 + 1) * l) / + static_cast((2 * l - 1) * (2 * l + 1)); + return cfg.coed[1] * cfg.coeff / (cfg.z * cfg.z * cfg.amassm * cfg.amassm) * + std::pow(enem / cfg.alfa, 3) * cfg.angd * cfg.aidsq; + } + const double expiy = continuum_expiy(y); + const double yy = y * y; + const double p2 = std::exp(y * (4.0 * std::atan(y / static_cast(n)) - M_PI)); + const int m = mm + 1; + if (n == 1) { + const double yf = yy / (1.0 + yy); + return cfg.coed[2] * cfg.pop[1] * cfg.picoef * cfg.angd * p2 * expiy * yf * + cfg.aidsq * powi(cfg.amzz[1], 2); + } + if (n == 2) { + double yf = 0.0; + if (m == 1) { + yf = yy * (4.0 + 3.0 * yy) * (4.0 + 5.0 * yy) / std::pow(4.0 + yy, 3) * + (cfg.pop[2] + 3.0 * cfg.pop[3]) / 4.0; + } else if (m == 2) { + yf = 4.0 * yy * (1.0 + yy) / std::pow(4.0 + yy, 2) * cfg.pop[2]; + } else { + yf = yy * yy * (12.0 + 11.0 * yy) / std::pow(4.0 + yy, 3) * cfg.pop[3]; + } + return cfg.coed[3] * cfg.picoef * cfg.angd * p2 * expiy * yf * cfg.aidsq * + powi(cfg.amzz[2], 2); + } + double yf = 0.0; + if (m == 1) { + yf = yy * (81.0 + 78.0 * yy + 13.0 * yy * yy) * + (81.0 + 126.0 * yy + 29.0 * yy * yy) / std::pow(9.0 + yy, 5) * + (cfg.pop[4] + 3.0 * cfg.pop[5] + 5.0 * cfg.pop[6]) / 9.0; + } else if (m == 2) { + yf = yy * (1.0 + yy) * std::pow(27.0 + 7.0 * yy, 2) / std::pow(9.0 + yy, 4) * + cfg.pop[4]; + } else if (m == 3) { + yf = 8.0 * yy * yy * (81.0 + 96.0 * yy + 19.0 * yy * yy) / + std::pow(9.0 + yy, 4) * cfg.pop[5]; + } else { + yf = 16.0 * std::pow(yy, 3) * (45.0 + 11.0 * yy) * (1.0 + yy) / + std::pow(9.0 + yy, 5) * cfg.pop[6]; + } + return cfg.coed[4] * cfg.picoef * cfg.angd * p2 * expiy * yf * cfg.aidsq * + powi(cfg.amzz[3], 2); +} + +double PhysicsEngine::rquau( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + double enem, + double y, + int m) const { + std::vector a(7, 0.0); + if (n <= 0) { + cfg.aiq = matelu(cfg, n1, l1, n2, l2, 2); + cfg.aiqsq = cfg.aiq * cfg.aiq; + const int l = (l1 + l2) / 2; + cfg.angq = (l2 == l1) ? 1.0 : 1.5; + cfg.angq *= static_cast((2 * l2 + 1) * l * (l + 1)) / + static_cast((2 * l - 1) * (2 * l + 1) * (2 * l + 3)); + return cfg.coeq[1] * cfg.coeff / powi(cfg.z * cfg.amassm, 4) * + std::pow(enem / cfg.alfa, 5) * cfg.angq * cfg.aiqsq; + } + const double extpy = continuum_extpy(y); + const double yy = y * y; + const double p = std::exp(y * (2.0 * std::atan(y / static_cast(n)) - M_PI)); + if (n == 1) { + const double yf = (1.0 + yy) / (4.0 + yy); + const double pf = powi(9.0 * p - 1.0, 2); + return cfg.coeq[2] * cfg.pop[1] * cfg.picoef * cfg.angq * pf * extpy * yf * + cfg.aiqsq * powi(cfg.amzz[1], 4); + } + if (n == 2) { + if (m != 2) { + const double yf = (4.0 + yy) / (1.0 + yy); + const double pf = powi(9.0 * (4.0 + 5.0 * yy) / (4.0 + yy) * p - 1.0, 2); + a[1] = cfg.coeq[3] * cfg.pop[2] * yf * pf; + } + if (m != 1) { + { + const double yf = yy / (1.0 + yy); + const double pf = powi(3.0 * p + 1.0, 2); + a[2] = cfg.coeq[4] * cfg.pop[3] * yf * pf; + } + { + const double yf = yy * (4.0 + yy) / ((1.0 + yy) * (9.0 + yy)); + const double pf = + powi((68.0 + 77.0 * yy) / (4.0 + yy) * p - 1.0, 2); + a[3] = cfg.coeq[5] * cfg.pop[3] * yf * pf; + } + } + return cfg.picoef * cfg.angq * (a[1] + a[2] + a[3]) * extpy * cfg.aiqsq * + powi(cfg.amzz[2], 4); + } + if (m <= 1) { + const double yf = powi(9.0 + yy, 2) / ((1.0 + yy) * (4.0 + yy)); + const double pf = powi( + (729.0 + 1134.0 * yy + 277.0 * yy * yy) / powi(9.0 + yy, 2) * p - 1.0, 2); + a[1] = cfg.coeq[6] * cfg.pop[4] * yf * pf; + } + if (m == 0 || m == 2) { + { + const double yf = yy / (1.0 + yy); + const double pf = powi((27.0 + 11.0 * yy) / (9.0 + yy) * p + 1.0, 2); + a[2] = cfg.coeq[7] * cfg.pop[5] * yf * pf; + } + { + const double yf = yy * (9.0 + yy) / ((1.0 + yy) * (4.0 + yy)); + const double pf = powi( + (1377.0 + 1944.0 * yy + 439.0 * yy * yy) / powi(9.0 + yy, 2) * p - 1.0, + 2); + a[3] = cfg.coeq[8] * cfg.pop[5] * yf * pf; + } + } + if (m == 0 || m == 3) { + { + const double yf = yy * yy / powi(9.0 + yy, 2); + a[4] = cfg.coeq[9] * cfg.pop[6] * yf * (p * p); + } + { + const double yf = yy * yy / ((1.0 + yy) * (4.0 + yy)); + const double pf = powi((63.0 + 47.0 * yy) / (9.0 + yy) * p + 1.0, 2); + a[5] = cfg.coeq[10] * cfg.pop[6] * yf * pf; + } + { + const double yf = + yy * yy * (9.0 + yy) / ((1.0 + yy) * (4.0 + yy) * (16.0 + yy)); + const double pf = powi( + (10773.0 + 14580.0 * yy + 3167.0 * yy * yy) / powi(9.0 + yy, 2) * p - 5.0, + 2); + a[6] = cfg.coeq[11] * cfg.pop[6] * yf * pf; + } + } + return cfg.picoef * cfg.angq * (a[1] + a[2] + a[3] + a[4] + a[5] + a[6]) * + extpy * cfg.aiqsq * powi(cfg.amzz[3], 4); +} + +double PhysicsEngine::roctu( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + double enem, + double y, + int m) const { + std::vector a(7, 0.0); + if (n <= 0) { + cfg.aio = matelu(cfg, n1, l1, n2, l2, 3); + cfg.aiosq = cfg.aio * cfg.aio; + const int l = (l1 + l2 + 1) / 2; + cfg.ango = (std::abs(l1 - l2) == 1) ? 1.5 : 2.5; + cfg.ango *= static_cast((2 * l2 + 1) * (l - 1) * l * (l + 1)) / + static_cast( + (2 * l - 3) * (2 * l - 1) * (2 * l + 1) * (2 * l + 3)); + return cfg.coeo[1] * cfg.coeff / powi(cfg.z * cfg.amassm, 6) * + std::pow(enem / cfg.alfa, 7) * cfg.ango * cfg.aiosq; + } + const double extpy = continuum_extpy(y); + const double yy = y * y; + const double p = std::exp(y * (2.0 * std::atan(y / static_cast(n)) - M_PI)); + if (n == 1) { + const double yf = + (1.0 + yy) * powi(3.0 + 2.0 * yy, 2) / (yy * (4.0 + yy) * (9.0 + yy)); + const double pf = + powi(15.0 * (1.0 + yy) / (3.0 + 2.0 * yy) * p - 1.0, 2); + return cfg.coeo[2] * cfg.pop[1] * cfg.picoef * cfg.ango * pf * extpy * yf * + cfg.aiosq * powi(cfg.amzz[1], 6); + } + if (n == 2) { + if (m != 2) { + const double yf = + (4.0 + yy) * powi(6.0 + yy, 2) / (yy * (1.0 + yy) * (9.0 + yy)); + const double pf = + powi(15.0 * (2.0 + 3.0 * yy) / (6.0 + yy) * p - 1.0, 2); + a[1] = cfg.coeo[3] * cfg.pop[2] * yf * pf; + } + if (m != 1) { + { + const double yf = (4.0 + yy) / (1.0 + yy); + const double pf = powi(3.0 * p + 1.0, 2); + a[2] = cfg.coeo[4] * cfg.pop[3] * yf * pf; + } + { + const double yf = (4.0 + yy) * powi(68.0 + 13.0 * yy, 2) / + ((1.0 + yy) * (9.0 + yy) * (16.0 + yy)); + const double pf = powi( + 5.0 * (116.0 + 149.0 * yy) / (68.0 + 13.0 * yy) * p - 1.0, 2); + a[3] = cfg.coeo[5] * cfg.pop[3] * yf * pf; + } + } + return cfg.picoef * cfg.ango * (a[1] + a[2] + a[3]) * extpy * cfg.aiosq * + powi(cfg.amzz[2], 6); + } + if (m <= 1) { + const double yf = + (9.0 + yy) * powi(27.0 + 2.0 * yy, 2) / (yy * (1.0 + yy) * (4.0 + yy)); + const double pf = powi( + 2.5 * (405.0 + 900.0 * yy + 254.0 * yy * yy) / ((9.0 + yy) * (27.0 + 2.0 * yy)) * + p - + 1.0, + 2); + a[1] = cfg.coeo[6] * cfg.pop[4] * yf * pf; + } + if (m == 0 || m == 2) { + { + const double yf = powi(9.0 + 2.0 * yy, 2) / ((1.0 + yy) * (4.0 + yy)); + const double pf = powi((27.0 + 13.0 * yy) / (9.0 + 2.0 * yy) * p + 1.0, 2); + a[2] = cfg.coeo[7] * cfg.pop[5] * yf * pf; + } + { + const double yf = (9.0 + yy) * powi(153.0 + 13.0 * yy, 2) / + ((1.0 + yy) * (4.0 + yy) * (16.0 + yy)); + const double pf = powi( + 5.0 * (2349.0 + 3744.0 * yy + 947.0 * yy * yy) / + ((9.0 + yy) * (153.0 + 13.0 * yy)) * + p - + 1.0, + 2); + a[3] = cfg.coeo[8] * cfg.pop[5] * yf * pf; + } + } + if (m == 0 || m == 3) { + { + const double yf = yy / (1.0 + yy); + const double pf = powi(2.0 * p + 1.0, 2); + a[4] = cfg.coeo[9] * cfg.pop[6] * yf * pf; + } + { + const double yf = yy * (9.0 + yy) / ((1.0 + yy) * (4.0 + yy)); + const double pf = powi((63.0 + 47.0 * yy) / (9.0 + yy) * p + 1.0, 2); + a[5] = cfg.coeo[10] * cfg.pop[6] * yf * pf; + } + { + const double yf = yy * (9.0 + yy) * powi(11.0 + yy, 2) / + ((1.0 + yy) * (4.0 + yy) * (16.0 + yy) * (25.0 + yy)); + const double pf = powi( + (1251.0 + 1850.0 * yy + 439.0 * yy * yy) / ((9.0 + yy) * (11.0 + yy)) * p - + 1.0, + 2); + a[6] = cfg.coeo[11] * cfg.pop[6] * yf * pf; + } + } + return cfg.picoef * cfg.ango * (a[1] + a[2] + a[3] + a[4] + a[5] + a[6]) * + extpy * cfg.aiosq * powi(cfg.amzz[3], 6); +} + +double PhysicsEngine::rmon( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + double y) const { + std::vector jm = cfg.jm; + const double coeff = rmon_coeff(cfg, y); + if (cfg.ij[1] != 0) { + for (int jj = 1; jj <= 10; ++jj) { + if (y > cfg.yj[1]) { + jm[jj] = std::min(cfg.jm[jj], cfg.jj1[1]); + } + } + } + if (n == 1) { + double a1 = 0.0; + if (cfg.ifm[1] == 1) { + return 0.0; + } + for (int jj = 1; jj <= 3; ++jj) { + if (jj > jm[1]) { + continue; + } + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + a1 += cfg.coemon[jj] * matel(cfg, n1, l1, n2, l2, j + 2, cfg.expmon[jj], 1) / b; + } + return a1 * a1 * coeff * cfg.pop[1]; + } + if (n == 2) { + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + const double yy = (1.0 + y * y) / (y * y); + if (cfg.ifm[2] + cfg.ifm[3] == 2) { + return 0.0; + } + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (cfg.ifm[2] != 1 && jj <= jm[2]) { + a1 += cfg.coemon[jj + 3] * + matel(cfg, n1, l1, n2, l2, j + 2, cfg.expmon[jj + 3], 2) / b; + } + if (cfg.ifm[3] != 1 && jj <= jm[3]) { + a2 += cfg.coemon[jj + 6] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expmon[jj + 6], 2) / b; + } + if (jj <= jm[4]) { + a3 += cfg.coemon[jj + 9] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expmon[jj + 9], 2) / b; + } + } + return ((a1 + a2) * (a1 + a2) * cfg.pop[2] + a3 * a3 * yy * cfg.pop[3]) * coeff; + } + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + double a4 = 0.0; + double a5 = 0.0; + double a6 = 0.0; + const double yy1 = (1.0 + y * y) / (y * y); + const double yy2 = (1.0 + y * y) * (4.0 + y * y) / std::pow(y, 4); + if (cfg.ifm[4] + cfg.ifm[5] + cfg.ifm[6] == 3) { + return 0.0; + } + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (cfg.ifm[4] != 1 && jj <= jm[5]) { + a1 += cfg.coemon[jj + 12] * + matel(cfg, n1, l1, n2, l2, j + 2, cfg.expmon[jj + 12], 3) / b; + } + if (cfg.ifm[5] != 1 && jj <= jm[6]) { + a2 += cfg.coemon[jj + 15] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expmon[jj + 15], 3) / b; + } + if (jj <= jm[7]) { + a3 += cfg.coemon[jj + 18] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expmon[jj + 18], 3) / b; + } + if (cfg.ifm[6] != 1 && jj <= jm[8]) { + a4 += cfg.coemon[jj + 21] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expmon[jj + 21], 3) / b; + } + if (jj <= jm[9]) { + a5 += cfg.coemon[jj + 24] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expmon[jj + 24], 3) / b; + } + if (jj <= jm[10]) { + a6 += cfg.coemon[jj + 27] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expmon[jj + 27], 3) / b; + } + } + return ((a1 + a2 + a3) * (a1 + a2 + a3) * cfg.pop[4] + + yy1 * (a4 + a5) * (a4 + a5) * cfg.pop[5] + yy2 * a6 * a6 * cfg.pop[6]) * + coeff; +} + +double PhysicsEngine::rdip( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + int m, + double y) const { + std::vector a(6, 0.0); + std::vector jd = cfg.jd; + const double extpy = continuum_extpy(y); + const double yy = y * y; + const double p = std::exp(y * (2.0 * std::atan(y / static_cast(n)) - M_PI)); + if (cfg.ij[2] != 0) { + for (int jj = 1; jj <= 14; ++jj) { + if (y > cfg.yj[2]) { + jd[jj] = std::min(cfg.jd[jj], cfg.jj1[2]); + } + } + } + if (n == 1) { + double a1 = 0.0; + if (cfg.ifd[1] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + if (jj > jd[1]) { + continue; + } + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + a1 += cfg.coedip[jj] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expdip[jj], 1) / b; + } + } + const double yf = yy / (1.0 + yy); + const double yg = (1.0 + yy) / yy; + return cfg.coedp[1] * extpy * cfg.picoef * cfg.angd * yg * + powi(yf * p * cfg.aid * cfg.amzz[1] - a1, 2) * cfg.pop[1]; + } + if (n == 2) { + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + if (m != 2) { + if (cfg.ifd[2] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jd[2]) { + a1 += cfg.coedip[jj + 3] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expdip[jj + 3], 2) / b; + } + if (jj <= jd[3]) { + a1 += cfg.coedip[jj + 6] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expdip[jj + 6], 2) / b; + } + } + } + const double yf = yy / (4.0 + yy); + const double yg = (1.0 + yy) / yy; + a[1] = cfg.coedp[2] * cfg.pop[2] * extpy * yg * + powi(yf * p * cfg.aid * cfg.amzz[2] - a1, 2); + } + if (m != 1) { + if (cfg.ifd[3] + cfg.ifd[4] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jd[4]) { + a2 += cfg.coedip[jj + 9] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expdip[jj + 9], 2) / b; + } + if (jj <= jd[5]) { + a3 += cfg.coedip[jj + 12] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expdip[jj + 12], 2) / b; + } + } + } + { + const double yf = yy / (4.0 + yy); + a[2] = cfg.coedp[3] * cfg.pop[3] * extpy * + powi(yf * p * cfg.aid * cfg.amzz[2] - a2, 2); + } + { + const double yf = yy * yy / powi(4.0 + yy, 2); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + a[3] = cfg.coedp[4] * cfg.pop[3] * extpy * yg * + powi(yf * p * cfg.aid * cfg.amzz[2] - a3, 2); + } + } + return cfg.picoef * cfg.angd * (a[1] + a[2] + a[3]); + } + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + double a4 = 0.0; + double a5 = 0.0; + if (m <= 1) { + if (cfg.ifd[5] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jd[6]) { + a1 += cfg.coedip[jj + 15] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expdip[jj + 15], 3) / b; + } + if (jj <= jd[7]) { + a1 += cfg.coedip[jj + 18] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expdip[jj + 18], 3) / b; + } + if (jj <= jd[8]) { + a1 += cfg.coedip[jj + 21] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expdip[jj + 21], 3) / b; + } + } + } + const double yf = yy * (27.0 + 7.0 * yy) / powi(9.0 + yy, 2); + const double yg = (1.0 + yy) / yy; + a[1] = cfg.coedp[5] * cfg.pop[4] * extpy * yg * + powi(yf * p * cfg.aid * cfg.amzz[3] - a1, 2); + } + if (m == 0 || m == 2) { + if (cfg.ifd[6] + cfg.ifd[7] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jd[9]) { + a2 += cfg.coedip[jj + 24] * + matel(cfg, n1, l1, n2, l2, j + 3, cfg.expdip[jj + 24], 3) / b; + } + if (jj <= jd[10]) { + a2 += cfg.coedip[jj + 27] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expdip[jj + 27], 3) / b; + } + if (jj <= jd[11]) { + a3 += cfg.coedip[jj + 30] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expdip[jj + 30], 3) / b; + } + if (jj <= jd[12]) { + a3 += cfg.coedip[jj + 33] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expdip[jj + 33], 3) / b; + } + } + } + { + const double yf = yy * (3.0 + yy) / powi(9.0 + yy, 2); + a[2] = cfg.coedp[6] * cfg.pop[5] * extpy * + powi(yf * p * cfg.aid * cfg.amzz[3] - a2, 2); + } + { + const double yf = yy * yy / powi(9.0 + yy, 2); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + a[3] = cfg.coedp[7] * cfg.pop[5] * extpy * yg * + powi(yf * p * cfg.aid * cfg.amzz[3] - a3, 2); + } + } + if (m == 0 || m == 3) { + if (cfg.ifd[8] + cfg.ifd[9] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jd[13]) { + a4 += cfg.coedip[jj + 36] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expdip[jj + 36], 3) / b; + } + if (jj <= jd[14]) { + a5 += cfg.coedip[jj + 39] * + matel(cfg, n1, l1, n2, l2, j + 7, cfg.expdip[jj + 39], 3) / b; + } + } + } + { + const double yf = yy * yy / powi(9.0 + yy, 2); + const double yg = (1.0 + yy) / yy; + a[4] = cfg.coedp[8] * cfg.pop[6] * extpy * yg * + powi(yf * p * cfg.aid * cfg.amzz[3] - a4, 2); + } + { + const double yf = powi(yy / (9.0 + yy), 3); + const double yg = + (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + a[5] = cfg.coedp[9] * cfg.pop[5] * extpy * yg * + powi(yf * p * cfg.aid * cfg.amzz[3] - a5, 2); + } + } + return cfg.picoef * cfg.angd * (a[1] + a[2] + a[3] + a[4] + a[5]); +} + +double PhysicsEngine::rqua( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + int m, + double y) const { + std::vector a(7, 0.0); + std::vector jq = cfg.jq; + const double extpy = continuum_extpy(y); + const double yy = y * y; + const double p = std::exp(y * (2.0 * std::atan(y / static_cast(n)) - M_PI)); + if (cfg.ij[3] != 0) { + for (int jj = 1; jj <= 15; ++jj) { + if (y > cfg.yj[3]) { + jq[jj] = std::min(cfg.jq[jj], cfg.jj1[3]); + } + } + } + if (n == 1) { + double a1 = 0.0; + if (cfg.ifq[1] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + if (jj > jq[1]) { + continue; + } + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + a1 += cfg.coequa[jj] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expqua[jj], 1) / b; + } + } + const double yf = yy / (4.0 + yy); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + const double pf = 9.0 * p - 1.0; + return cfg.coeq[2] * extpy * cfg.picoef * cfg.angq * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[1], 2) - a1, 2) * cfg.pop[1]; + } + if (n == 2) { + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + if (m != 2) { + if (cfg.ifq[2] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jq[2]) { + a1 += cfg.coequa[jj + 3] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expqua[jj + 3], 2) / b; + } + if (jj <= jq[3]) { + a1 += cfg.coequa[jj + 6] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expqua[jj + 6], 2) / b; + } + } + } + const double yf = yy / (1.0 + yy); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + const double pf = 9.0 * (4.0 + 5.0 * yy) / (4.0 + yy) * p - 1.0; + a[1] = cfg.coeq[3] * cfg.pop[2] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[2], 2) - a1, 2); + } + if (m != 1) { + if (cfg.ifq[3] + cfg.ifq[4] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jq[4]) { + a2 += cfg.coequa[jj + 9] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expqua[jj + 9], 2) / b; + } + if (jj <= jq[5]) { + a3 += cfg.coequa[jj + 12] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expqua[jj + 12], 2) / b; + } + } + } + { + const double yf = yy / (1.0 + yy); + const double yg = (1.0 + yy) / yy; + const double pf = 3.0 * p + 1.0; + a[2] = cfg.coeq[4] * cfg.pop[3] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[2], 2) - a2, 2); + } + { + const double yf = yy * yy / ((1.0 + yy) * (9.0 + yy)); + const double yg = + (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + const double pf = (68.0 + 77.0 * yy) / (4.0 + yy) * p - 1.0; + a[3] = cfg.coeq[5] * cfg.pop[3] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[2], 2) - a3, 2); + } + } + return cfg.picoef * cfg.angq * (a[1] + a[2] + a[3]); + } + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + double a4 = 0.0; + double a5 = 0.0; + double a6 = 0.0; + if (m <= 1) { + if (cfg.ifq[5] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jq[6]) { + a1 += cfg.coequa[jj + 15] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expqua[jj + 15], 3) / b; + } + if (jj <= jq[7]) { + a1 += cfg.coequa[jj + 18] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expqua[jj + 18], 3) / b; + } + if (jj <= jq[8]) { + a1 += cfg.coequa[jj + 21] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expqua[jj + 21], 3) / b; + } + } + } + const double yf = yy * (9.0 + yy) / ((1.0 + yy) * (4.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + const double pf = + (729.0 + 1134.0 * yy + 277.0 * yy * yy) / powi(9.0 + yy, 2) * p - 1.0; + a[1] = cfg.coeq[6] * cfg.pop[4] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[3], 2) - a1, 2); + } + if (m == 0 || m == 2) { + if (cfg.ifq[6] + cfg.ifq[7] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jq[9]) { + a2 += cfg.coequa[jj + 24] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expqua[jj + 24], 3) / b; + } + if (jj <= jq[10]) { + a2 += cfg.coequa[jj + 27] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expqua[jj + 27], 3) / b; + } + if (jj <= jq[11]) { + a3 += cfg.coequa[jj + 30] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expqua[jj + 30], 3) / b; + } + if (jj <= jq[12]) { + a3 += cfg.coequa[jj + 33] * + matel(cfg, n1, l1, n2, l2, j + 7, cfg.expqua[jj + 33], 3) / b; + } + } + } + { + const double yf = yy / (1.0 + yy); + const double yg = (1.0 + yy) / yy; + const double pf = (27.0 + 11.0 * yy) / (9.0 + yy) * p + 1.0; + a[2] = cfg.coeq[7] * cfg.pop[5] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[3], 2) - a2, 2); + } + { + const double yf = yy * yy / ((1.0 + yy) * (4.0 + yy)); + const double yg = + (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + const double pf = + (1377.0 + 1944.0 * yy + 439.0 * yy * yy) / powi(9.0 + yy, 2) * p - 1.0; + a[3] = cfg.coeq[8] * cfg.pop[5] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[3], 2) - a3, 2); + } + } + if (m == 0 || m == 3) { + if (cfg.ifq[8] + cfg.ifq[9] + cfg.ifq[10] != 3) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jq[13]) { + a4 += cfg.coequa[jj + 36] * + matel(cfg, n1, l1, n2, l2, j + 4, cfg.expqua[jj + 36], 3) / b; + } + if (jj <= jq[14]) { + a5 += cfg.coequa[jj + 39] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expqua[jj + 39], 3) / b; + } + if (jj <= jq[15]) { + a6 += cfg.coequa[jj + 42] * + matel(cfg, n1, l1, n2, l2, j + 8, cfg.expqua[jj + 42], 3) / b; + } + } + } + { + const double yf = yy / (9.0 + yy); + a[4] = cfg.coeq[9] * cfg.pop[6] * extpy * + powi(yf * p * cfg.aiq * powi(cfg.amzz[3], 2) - a4, 2); + } + { + const double yf = yy * yy / ((1.0 + yy) * (4.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + const double pf = (63.0 + 47.0 * yy) / (9.0 + yy) * p + 1.0; + a[5] = cfg.coeq[10] * cfg.pop[6] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[3], 2) - a5, 2); + } + { + const double yf = + std::pow(yy, 3) / ((1.0 + yy) * (4.0 + yy) * (16.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) * (16.0 + yy) / + std::pow(yy, 4); + const double pf = + (10773.0 + 14580.0 * yy + 3167.0 * yy * yy) / powi(9.0 + yy, 2) * p - 5.0; + a[6] = cfg.coeq[11] * cfg.pop[6] * extpy * yg * + powi(yf * pf * cfg.aiq * powi(cfg.amzz[3], 2) - a6, 2); + } + } + return cfg.picoef * cfg.angq * (a[1] + a[2] + a[3] + a[4] + a[5] + a[6]); +} + +double PhysicsEngine::roct( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2, + int n, + int m, + double y) const { + std::vector a(7, 0.0); + std::vector jo = cfg.jo; + const double extpy = continuum_extpy(y); + const double yy = y * y; + const double p = std::exp(y * (2.0 * std::atan(y / static_cast(n)) - M_PI)); + if (cfg.ij[4] != 0) { + for (int jj = 1; jj <= 15; ++jj) { + if (y > cfg.yj[4]) { + jo[jj] = std::min(cfg.jo[jj], cfg.jj1[4]); + } + } + } + if (n == 1) { + double a1 = 0.0; + if (cfg.ifo[1] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + if (jj > jo[1]) { + continue; + } + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + a1 += cfg.coeoct[jj] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expoct[jj], 1) / b; + } + } + const double yf = yy * (3.0 + 2.0 * yy) / ((4.0 + yy) * (9.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + const double pf = 15.0 * (1.0 + yy) / (3.0 + 2.0 * yy) * p - 1.0; + return cfg.coeo[2] * cfg.picoef * cfg.ango * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[1], 3) - a1, 2) * cfg.pop[1]; + } + if (n == 2) { + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + if (m != 2) { + if (cfg.ifo[2] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jo[2]) { + a1 += cfg.coeoct[jj + 3] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expoct[jj + 3], 2) / b; + } + if (jj <= jo[3]) { + a1 += cfg.coeoct[jj + 6] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expoct[jj + 6], 2) / b; + } + } + } + const double yf = yy * (6.0 + yy) / ((1.0 + yy) * (9.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + const double pf = 15.0 * (2.0 + 3.0 * yy) / (6.0 + yy) * p - 1.0; + a[1] = cfg.coeo[3] * cfg.pop[2] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[2], 3) - a1, 2); + } + if (m != 1) { + if (cfg.ifo[3] + cfg.ifo[4] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jo[4]) { + a2 += cfg.coeoct[jj + 9] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expoct[jj + 9], 2) / b; + } + if (jj <= jo[5]) { + a3 += cfg.coeoct[jj + 12] * + matel(cfg, n1, l1, n2, l2, j + 7, cfg.expoct[jj + 12], 2) / b; + } + } + } + { + const double yf = yy / (1.0 + yy); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + const double pf = 3.0 * p + 1.0; + a[2] = cfg.coeo[4] * cfg.pop[3] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[2], 3) - a2, 2); + } + { + const double yf = yy * yy * (68.0 + 13.0 * yy) / + ((1.0 + yy) * (9.0 + yy) * (16.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) * (16.0 + yy) / + std::pow(yy, 4); + const double pf = + 5.0 * (116.0 + 149.0 * yy) / (68.0 + 13.0 * yy) * p - 1.0; + a[3] = cfg.coeo[5] * cfg.pop[3] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[2], 3) - a3, 2); + } + } + return cfg.picoef * cfg.ango * (a[1] + a[2] + a[3]); + } + double a1 = 0.0; + double a2 = 0.0; + double a3 = 0.0; + double a4 = 0.0; + double a5 = 0.0; + double a6 = 0.0; + if (m <= 1) { + if (cfg.ifo[5] != 1) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jo[6]) { + a1 += cfg.coeoct[jj + 15] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expoct[jj + 15], 3) / b; + } + if (jj <= jo[7]) { + a1 += cfg.coeoct[jj + 18] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expoct[jj + 18], 3) / b; + } + if (jj <= jo[8]) { + a1 += cfg.coeoct[jj + 21] * + matel(cfg, n1, l1, n2, l2, j + 7, cfg.expoct[jj + 21], 3) / b; + } + } + } + const double yf = yy * (27.0 + 2.0 * yy) / ((1.0 + yy) * (4.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + const double pf = + 2.5 * (405.0 + 900.0 * yy + 254.0 * yy * yy) / ((9.0 + yy) * (27.0 + 2.0 * yy)) * + p - + 1.0; + a[1] = cfg.coeo[6] * cfg.pop[4] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[3], 3) - a1, 2); + } + if (m == 0 || m == 2) { + if (cfg.ifo[6] + cfg.ifo[7] != 2) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jo[9]) { + a2 += cfg.coeoct[jj + 24] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expoct[jj + 24], 3) / b; + } + if (jj <= jo[10]) { + a2 += cfg.coeoct[jj + 27] * + matel(cfg, n1, l1, n2, l2, j + 6, cfg.expoct[jj + 27], 3) / b; + } + if (jj <= jo[11]) { + a3 += cfg.coeoct[jj + 30] * + matel(cfg, n1, l1, n2, l2, j + 7, cfg.expoct[jj + 30], 3) / b; + } + if (jj <= jo[12]) { + a3 += cfg.coeoct[jj + 33] * + matel(cfg, n1, l1, n2, l2, j + 8, cfg.expoct[jj + 33], 3) / b; + } + } + } + { + const double yf = yy * (9.0 + 2.0 * yy) / ((1.0 + yy) * (4.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) / (yy * yy); + const double pf = (27.0 + 13.0 * yy) / (9.0 + 2.0 * yy) * p + 1.0; + a[2] = cfg.coeo[7] * cfg.pop[5] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[3], 3) - a2, 2); + } + { + const double yf = yy * yy * (153.0 + 13.0 * yy) / + ((1.0 + yy) * (4.0 + yy) * (16.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) * (16.0 + yy) / + std::pow(yy, 4); + const double pf = + 5.0 * (2349.0 + 3744.0 * yy + 947.0 * yy * yy) / + ((9.0 + yy) * (153.0 + 13.0 * yy)) * + p - + 1.0; + a[3] = cfg.coeo[8] * cfg.pop[5] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[3], 3) - a3, 2); + } + } + if (m == 0 || m == 3) { + if (cfg.ifo[8] + cfg.ifo[9] + cfg.ifo[10] != 3) { + for (int jj = 1; jj <= 3; ++jj) { + const int j = cfg.jk[jj]; + const double b = std::pow(y, cfg.ne[jj]); + if (jj <= jo[13]) { + a4 += cfg.coeoct[jj + 36] * + matel(cfg, n1, l1, n2, l2, j + 5, cfg.expoct[jj + 36], 3) / b; + } + if (jj <= jo[14]) { + a5 += cfg.coeoct[jj + 39] * + matel(cfg, n1, l1, n2, l2, j + 7, cfg.expoct[jj + 39], 3) / b; + } + if (jj <= jo[15]) { + a6 += cfg.coeoct[jj + 42] * + matel(cfg, n1, l1, n2, l2, j + 9, cfg.expoct[jj + 42], 3) / b; + } + } + } + { + const double yf = yy / (1.0 + yy); + const double yg = (1.0 + yy) / yy; + const double pf = 2.0 * p + 1.0; + a[4] = cfg.coeo[9] * cfg.pop[6] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[3], 3) - a4, 2); + } + { + const double yf = yy * yy / ((1.0 + yy) * (4.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) / std::pow(yy, 3); + const double pf = (63.0 + 47.0 * yy) / (9.0 + yy) * p + 1.0; + a[5] = cfg.coeo[10] * cfg.pop[6] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[3], 3) - a5, 2); + } + { + const double yf = + std::pow(yy, 3) * (11.0 + yy) / + ((1.0 + yy) * (4.0 + yy) * (16.0 + yy) * (25.0 + yy)); + const double yg = (1.0 + yy) * (4.0 + yy) * (9.0 + yy) * (16.0 + yy) * + (25.0 + yy) / std::pow(yy, 5); + const double pf = + (1251.0 + 1850.0 * yy + 439.0 * yy * yy) / ((9.0 + yy) * (11.0 + yy)) * p - + 1.0; + a[6] = cfg.coeo[11] * cfg.pop[6] * extpy * yg * + powi(yf * pf * cfg.aio * powi(cfg.amzz[3], 3) - a6, 2); + } + } + return cfg.picoef * cfg.ango * (a[1] + a[2] + a[3] + a[4] + a[5] + a[6]); +} + +double PhysicsEngine::transition_rate( + KernelState& cfg, + int n1, + int l1, + int n2, + int l2) const { + cfg.irr = 0; + for (int i = 1; i <= 4; ++i) { + cfg.ra[i] = 0.0; + cfg.rd[i] = 0.0; + cfg.rsa[i] = 0.0; + } + cfg.rau = 0.0; + cfg.rad = 0.0; + double rate_value = 0.0; + const int l = std::abs(l1 - l2) + 1; + if (l > 4) { + return 0.0; + } + double enem = cfg.energ; + if (cfg.ijk == 0) { + const int ll1 = (l1 == 0) ? 0 : 1; + const int ll2 = (l2 == 0) ? 0 : 1; + const int lj11 = 2 * l1 + 1; + const int lj12 = lj11 - ll1; + const int lj21 = 2 * l2 + 1; + const int lj22 = lj21 - ll2; + double ene1 = 0.5 * (cfg.energy[n1][lj11] + cfg.energy[n1][lj12]); + double ene2 = 0.5 * (cfg.energy[n2][lj21] + cfg.energy[n2][lj22]); + if (n2 == 1 && cfg.d2p1sm > 1.0e-20) { + ene2 = cfg.d2p1sm * cfg.amasse * 1.0e-6 + + 0.5 * (cfg.energy[2][2] + cfg.energy[2][3]); + } + enem = (ene2 - ene1) * 1.0e6 / cfg.amasse; + } + std::vector y = one_based({0.0, 0.0, 0.0}, 3, 0.0); + std::vector iy = one_based({1, 1, 1}, 3, 0); + for (int i = 1; i <= 3; ++i) { + const double t = enem - cfg.bem[i]; + if (t > 0.0) { + iy[i] = 0; + y[i] = cfg.zsa[i] / std::sqrt(t * t + 2.0 * t); + } + } + const int n12 = (n1 + n2 + 1) / 2; + + if (l == 1) { + for (int i = 1; i <= cfg.k0; ++i) { + cfg.r0[i] = 0.0; + const int nn = cfg.nn0[i]; + if (iy[nn] != 0) { + continue; + } + if (y[nn] < cfg.yc[nn]) { + continue; + } + cfg.r0[i] = rmon(cfg, n1, l1, n2, l2, nn, y[nn]); + rate_value += cfg.r0[i]; + cfg.rau += cfg.r0[i]; + cfg.irr += 1; + cfg.rr[cfg.irr] = cfg.r0[i]; + cfg.rsa[nn] += cfg.r0[i]; + } + cfg.ra[1] = cfg.rau; + } + if (l == 2) { + for (int i = 1; i <= cfg.k1; ++i) { + cfg.r1[i] = 0.0; + const int nn = cfg.nn1[i]; + const int mm = (nn == 0) ? 1 : nn; + int pen = 0; + if (nn != 0) { + if (iy[nn] != 0) { + continue; + } + if (y[nn] > cfg.yc[nn]) { + pen = cfg.ip1[i]; + } + } + if (pen == 0) { + cfg.r1[i] = rdipu(cfg, n1, l1, n2, l2, nn, enem, y[mm], cfg.m1[i]); + } else if (n12 >= cfg.iq1[i]) { + cfg.r1[i] = rdip(cfg, n1, l1, n2, l2, nn, cfg.m1[i], y[mm]); + } else { + cfg.r1[i] = rdipu(cfg, n1, l1, n2, l2, nn, enem, y[mm], cfg.m1[i]); + } + rate_value += cfg.r1[i]; + if (nn == 0) { + cfg.rad += cfg.r1[i]; + cfg.rd[2] += cfg.r1[i]; + } else { + cfg.rau += cfg.r1[i]; + cfg.ra[2] += cfg.r1[i]; + cfg.rsa[nn] += cfg.r1[i]; + } + cfg.irr += 1; + cfg.rr[cfg.irr] = cfg.r1[i]; + } + } + if ((l == 1 || l == 3) && cfg.k2 != 0 && l1 + l2 != 0) { + for (int i = 1; i <= cfg.k2; ++i) { + cfg.r2[i] = 0.0; + const int nn = cfg.nn2[i]; + const int mm = (nn == 0) ? 1 : nn; + int pen = 0; + if (nn != 0) { + if (iy[nn] != 0) { + continue; + } + if (y[nn] > cfg.yc[nn]) { + pen = cfg.ip2[i]; + } + } + if (pen == 0) { + cfg.r2[i] = rquau(cfg, n1, l1, n2, l2, nn, enem, y[mm], cfg.m2[i]); + } else if (n12 >= cfg.iq2[i]) { + cfg.r2[i] = rqua(cfg, n1, l1, n2, l2, nn, cfg.m2[i], y[mm]); + } else { + cfg.r2[i] = rquau(cfg, n1, l1, n2, l2, nn, enem, y[mm], cfg.m2[i]); + } + rate_value += cfg.r2[i]; + if (nn == 0) { + cfg.rad += cfg.r2[i]; + cfg.rd[3] += cfg.r2[i]; + } else { + cfg.rau += cfg.r2[i]; + cfg.ra[3] += cfg.r2[i]; + cfg.rsa[nn] += cfg.r2[i]; + } + cfg.irr += 1; + cfg.rr[cfg.irr] = cfg.r2[i]; + } + } + if ((l == 2 || l == 4) && cfg.k3 != 0 && l1 + l2 != 1) { + for (int i = 1; i <= cfg.k3; ++i) { + cfg.r3[i] = 0.0; + const int nn = cfg.nn3[i]; + const int mm = (nn == 0) ? 1 : nn; + int pen = 0; + if (nn != 0) { + if (iy[nn] != 0) { + continue; + } + if (y[mm] > cfg.yc[nn]) { + pen = cfg.ip3[i]; + } + } + if (pen == 0) { + cfg.r3[i] = roctu(cfg, n1, l1, n2, l2, nn, enem, y[mm], cfg.m3[i]); + } else if (n12 >= cfg.iq3[i]) { + cfg.r3[i] = roct(cfg, n1, l1, n2, l2, nn, cfg.m3[i], y[mm]); + } else { + cfg.r3[i] = roctu(cfg, n1, l1, n2, l2, nn, enem, y[mm], cfg.m3[i]); + } + rate_value += cfg.r3[i]; + if (nn == 0) { + cfg.rad += cfg.r3[i]; + cfg.rd[4] += cfg.r3[i]; + } else { + cfg.rau += cfg.r3[i]; + cfg.ra[4] += cfg.r3[i]; + cfg.rsa[nn] += cfg.r3[i]; + } + cfg.irr += 1; + cfg.rr[cfg.irr] = cfg.r3[i]; + } + } + return rate_value; +} + +} // namespace mocca::detail diff --git a/src/physics_engine.hpp b/src/physics_engine.hpp new file mode 100644 index 0000000..1e1454a --- /dev/null +++ b/src/physics_engine.hpp @@ -0,0 +1,228 @@ +#pragma once + +#include +#include +#include +#include +#include +#include + +#include "wide_float.hpp" + +namespace mocca::detail { + +using NumericTables = std::unordered_map>; + +struct KernelState { + explicit KernelState(const NumericTables& numeric_tables); + + std::vector warnings; + + int ijk{0}; + double energ{0.0}; + double econs{5.505355e-03}; + double econst{0.0}; + double d2p1sm{0.0}; + double d2p1s{0.0}; + + std::vector bem; + std::vector zsa; + std::vector be; + + int k0{3}; + int k1{4}; + int k2{4}; + int k3{4}; + + std::vector nn0; + std::vector nn1; + std::vector nn2; + std::vector nn3; + + std::vector r0; + std::vector r1; + std::vector r2; + std::vector r3; + + std::vector ip1; + std::vector ip2; + std::vector ip3; + std::vector iq1; + std::vector iq2; + std::vector iq3; + + std::vector f; + double fd{15.0}; + + double pi{3.1415926535}; + double picoef{1.298778e17}; + double amassm{206.7686}; + std::vector ne; + std::vector jk; + double coeff{4.134139e16}; + double alfa{7.297353e-03}; + double amasse{511003.4}; + + double z{0.0}; + double zsk{0.0}; + double zsl{0.0}; + double zsm{0.0}; + double zskz{0.0}; + double zslz{0.0}; + double zsmz{0.0}; + + std::vector amzz; + std::vector expmon; + std::vector expdip; + std::vector expqua; + std::vector expoct; + std::vector coemon; + std::vector coedip; + std::vector coequa; + std::vector coeoct; + + std::vector ifm; + std::vector ifd; + std::vector ifq; + std::vector ifo; + + double angd{0.0}; + double angq{0.0}; + double ango{0.0}; + double aid{0.0}; + double aiq{0.0}; + double aio{0.0}; + double aidsq{0.0}; + double aiqsq{0.0}; + double aiosq{0.0}; + std::vector coedp; + std::vector coeq; + std::vector coeo; + std::vector coed; + + std::vector ll; + + std::vector m1; + std::vector m2; + std::vector m3; + std::vector yc; + int idb{0}; + + int irr{0}; + std::vector rr; + double rau{0.0}; + double rad{0.0}; + std::vector ra; + std::vector rd; + std::vector rsa; + + std::vector pop; + std::vector jtm; + std::vector jtd; + std::vector jtq; + std::vector jto; + + std::vector jm; + std::vector jd; + std::vector jq; + std::vector jo; + int iyc{0}; + std::vector ij; + std::vector yj; + std::vector jj1; + + double ehigh{20.0}; + double elow{0.040}; + double climit{1.0e-06}; + double eres{0.000300}; + double esp{0.0}; + double espm{0.0}; + + int m{1}; + std::vector line_e; + std::vector line_ai; + std::vector line_ia; + std::vector> energy; + + double dza{0.0}; + double dza2{0.0}; + double dredm{0.0}; + + int icc{0}; + std::vector cd; + double ea{99.0}; + double eb{99.0}; + int idr{0}; + + double zmk{2.0}; + double zml{4.0}; + double zmm{9.0}; + double zmkm{4.0}; + double zmlm{8.0}; + double zmmm{18.0}; + int ivers{0}; + + std::vector pl; + std::vector npol; + int ipol{0}; + double cl1{0.0}; + double cl2{0.0}; + int ide{10000}; + std::vector pln; + int ip8{0}; + + double a{140.0}; + double cfm{0.0}; + double tfm{2.3001}; + double step{0.0}; + double rmatch{0.0}; + double widthk{0.0}; + std::vector ipc; + + int nopt{0}; + int nmax{15}; + double alexp{0.0}; + + double amassa{0.0}; + double amassn{931.48}; + double hbar{6.582173e-16}; +}; + +[[nodiscard]] NumericTables load_numeric_tables(const std::filesystem::path& fortran_path); +[[nodiscard]] int state_index(int n, int l); + +class PhysicsEngine { +public: + explicit PhysicsEngine(const NumericTables& numeric_tables, int precision_digits = 120); + + void prepare_case(KernelState& cfg) const; + [[nodiscard]] double transition_rate(KernelState& cfg, int n1, int l1, int n2, int l2) const; + +private: + [[nodiscard]] const std::vector& factor_table(double fd) const; + [[nodiscard]] double powi(double base, int exponent) const; + [[nodiscard]] double continuum_extpy(double y) const; + [[nodiscard]] double continuum_expiy(double y) const; + [[nodiscard]] double rmon_coeff(const KernelState& cfg, double y) const; + [[nodiscard]] double point(const KernelState& cfg, int n, int j) const; + [[nodiscard]] double matel(KernelState& cfg, int n1, int l1, int n2, int l2, int l, double a, int n) const; + [[nodiscard]] double matelu(KernelState& cfg, int n1, int l1, int n2, int l2, int l) const; + [[nodiscard]] double rdipu(KernelState& cfg, int n1, int l1, int n2, int l2, int n, double enem, double y, int mm) const; + [[nodiscard]] double rquau(KernelState& cfg, int n1, int l1, int n2, int l2, int n, double enem, double y, int m) const; + [[nodiscard]] double roctu(KernelState& cfg, int n1, int l1, int n2, int l2, int n, double enem, double y, int m) const; + [[nodiscard]] double rmon(KernelState& cfg, int n1, int l1, int n2, int l2, int n, double y) const; + [[nodiscard]] double rdip(KernelState& cfg, int n1, int l1, int n2, int l2, int n, int m, double y) const; + [[nodiscard]] double rqua(KernelState& cfg, int n1, int l1, int n2, int l2, int n, int m, double y) const; + [[nodiscard]] double roct(KernelState& cfg, int n1, int l1, int n2, int l2, int n, int m, double y) const; + + void warn(KernelState& cfg, const std::string& message) const; + void apply_input_energy_defaults(KernelState& cfg) const; + void ffix(KernelState& cfg) const; + + const NumericTables& tables_; + double default_amassm_{206.7686}; + int precision_digits_; + unsigned long precision_bits_; +}; + +} // namespace mocca::detail diff --git a/src/wide_float.hpp b/src/wide_float.hpp new file mode 100644 index 0000000..eb48f07 --- /dev/null +++ b/src/wide_float.hpp @@ -0,0 +1,85 @@ +#pragma once + +#include +#include + +namespace mocca::detail { + +class WideFloat { +public: + WideFloat() = default; + WideFloat(int value) : value_(static_cast(value)) {} + WideFloat(long value) : value_(static_cast(value)) {} + WideFloat(double value) : value_(static_cast(value)) {} + WideFloat(long double value) : value_(value) {} + WideFloat(int value, unsigned long) : value_(static_cast(value)) {} + WideFloat(long value, unsigned long) : value_(static_cast(value)) {} + WideFloat(double value, unsigned long) : value_(static_cast(value)) {} + WideFloat(long double value, unsigned long) : value_(value) {} + WideFloat(const std::string& value, unsigned long) : value_(std::stold(value)) {} + + [[nodiscard]] double get_d() const { + return static_cast(value_); + } + + [[nodiscard]] long double raw() const { + return value_; + } + + WideFloat& operator+=(const WideFloat& other) { + value_ += other.value_; + return *this; + } + + WideFloat& operator-=(const WideFloat& other) { + value_ -= other.value_; + return *this; + } + + WideFloat& operator*=(const WideFloat& other) { + value_ *= other.value_; + return *this; + } + + WideFloat& operator/=(const WideFloat& other) { + value_ /= other.value_; + return *this; + } + + friend WideFloat operator+(WideFloat lhs, const WideFloat& rhs) { + lhs += rhs; + return lhs; + } + + friend WideFloat operator-(WideFloat lhs, const WideFloat& rhs) { + lhs -= rhs; + return lhs; + } + + friend WideFloat operator*(WideFloat lhs, const WideFloat& rhs) { + lhs *= rhs; + return lhs; + } + + friend WideFloat operator/(WideFloat lhs, const WideFloat& rhs) { + lhs /= rhs; + return lhs; + } + + friend bool operator<(const WideFloat& lhs, const WideFloat& rhs) { + return lhs.value_ < rhs.value_; + } + +private: + long double value_{0.0L}; +}; + +inline WideFloat abs(const WideFloat& value) { + return std::fabsl(value.raw()); +} + +inline WideFloat sqrt(const WideFloat& value) { + return std::sqrt(value.raw()); +} + +} // namespace mocca::detail diff --git a/tools/card_to_json.py b/tools/card_to_json.py new file mode 100644 index 0000000..02a1002 --- /dev/null +++ b/tools/card_to_json.py @@ -0,0 +1,455 @@ +#!/usr/bin/env python3 +from __future__ import annotations + +import argparse +import json +import re +from dataclasses import dataclass, field +from pathlib import Path + + +def one_based(values: list[float] | list[int], size: int, fill: float | int = 0) -> list[float] | list[int]: + padded = list(values) + if len(padded) < size: + padded.extend([fill] * (size - len(padded))) + return [fill] + padded + + +def new_energy_table() -> list[list[float]]: + return [[0.0 for _ in range(41)] for _ in range(21)] + + +def state_index(n: int, l: int) -> int: + return n * (n - 1) // 2 + l + 1 + + +@dataclass +class DeckConfig: + amassa: float = 0.0 + amassn: float = 931.48 + d2p1s: float = 0.0 + be: list[float] = field(default_factory=lambda: one_based([0.0, 0.0, 0.0], 3, 0.0)) + k0: int = 3 + k1: int = 4 + k2: int = 4 + k3: int = 4 + nn0: list[int] = field(default_factory=lambda: one_based([1, 2, 3], 3, 0)) + nn1: list[int] = field(default_factory=lambda: one_based([0, 1, 2, 3, 3, 3, 3], 7, 0)) + nn2: list[int] = field(default_factory=lambda: one_based([0, 1, 2, 3, 3, 3, 3], 7, 0)) + nn3: list[int] = field(default_factory=lambda: one_based([0, 1, 2, 3, 3, 3, 3], 7, 0)) + ip1: list[int] = field(default_factory=lambda: one_based([0, 1, 1, 1, 1, 1, 1], 7, 0)) + ip2: list[int] = field(default_factory=lambda: one_based([0, 1, 1, 1, 1, 1, 1], 7, 0)) + ip3: list[int] = field(default_factory=lambda: one_based([0, 1, 1, 1, 1, 1, 1], 7, 0)) + iq1: list[int] = field(default_factory=lambda: one_based([0] * 7, 7, 0)) + iq2: list[int] = field(default_factory=lambda: one_based([0] * 7, 7, 0)) + iq3: list[int] = field(default_factory=lambda: one_based([0] * 7, 7, 0)) + fd: float = 15.0 + amassm: float = 206.7686 + amasse: float = 511003.4 + z: float = 0.0 + zsk: float = 0.0 + zsl: float = 0.0 + zsm: float = 0.0 + m1: list[int] = field(default_factory=lambda: one_based([0, 0, 0, 0, 1, 2, 3], 7, 0)) + m2: list[int] = field(default_factory=lambda: one_based([0, 0, 0, 0, 1, 2, 3], 7, 0)) + m3: list[int] = field(default_factory=lambda: one_based([0, 0, 0, 0, 1, 2, 3], 7, 0)) + pop: list[float] = field(default_factory=lambda: one_based([1.0] * 6, 6, 0.0)) + ehigh: float = 20.0 + elow: float = 0.040 + climit: float = 1.0e-06 + eres: float = 0.000300 + ea: float = 99.0 + eb: float = 99.0 + a: float = 140.0 + cfm: float = 0.0 + tfm: float = 2.3001 + step: float = 0.0 + rmatch: float = 0.0 + widthk: float = 0.0 + nopt: int = 0 + nmax: int = 15 + alexp: float = 0.0 + energy: list[list[float]] = field(default_factory=new_energy_table) + npol: list[int] = field(default_factory=lambda: one_based([-1] * 20, 20, 0)) + ipol: int = 0 + idb: int = 0 + yc: list[float] = field(default_factory=lambda: one_based([1.0, 1.0, 1.0, 1.0], 4, 0.0)) + ipc: list[int] = field(default_factory=lambda: one_based([0, 0, 0], 3, 0)) + cl1: float = 0.0 + cl2: float = 0.0 + esp: float = 0.0 + ide: int = 10000 + jtm: list[int] = field(default_factory=lambda: one_based([1] * 6, 6, 0)) + jtd: list[int] = field(default_factory=lambda: one_based([1] * 6, 6, 0)) + jtq: list[int] = field(default_factory=lambda: one_based([1] * 6, 6, 0)) + jto: list[int] = field(default_factory=lambda: one_based([1] * 6, 6, 0)) + pl: list[float] = field(default_factory=lambda: one_based([0.0] * 20, 20, 0.0)) + pln: list[float] = field(default_factory=lambda: one_based([0.0] * 210, 210, 0.0)) + ip8: int = 0 + warnings: list[str] = field(default_factory=list) + + +NUMBER_PATTERN = re.compile(r"[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[EeDd][+-]?\d+)?") + + +def parse_numbers(payload: str) -> list[float]: + payload = payload.split(";", 1)[0] + values = [token.replace("D", "E").replace("d", "E") for token in NUMBER_PATTERN.findall(payload)] + return [float(value) for value in values] + + +def parse_ints(payload: str) -> list[int]: + return [int(round(value)) for value in parse_numbers(payload)] + + +def apply_card(cfg: DeckConfig, code: str, payload: str) -> str | None: + code = code.strip().upper() + if not code: + return None + if code == "STO": + return "stop" + if code == "XEQ": + return "execute" + + if code == "AMA": + values = parse_numbers(payload) + if values: + cfg.amassa = values[0] + elif code == "AMN": + values = parse_numbers(payload) + if values: + cfg.amassn = values[0] + elif code == "D21": + values = parse_numbers(payload) + if values: + cfg.d2p1s = values[0] + elif code == "BE": + for index, value in enumerate(parse_numbers(payload)[:3], start=1): + cfg.be[index] = value + elif code == "K": + values = parse_ints(payload) + if len(values) >= 4: + cfg.k0, cfg.k1, cfg.k2, cfg.k3 = values[:4] + elif code == "NN0": + for index, value in enumerate(parse_ints(payload)[: cfg.k0], start=1): + cfg.nn0[index] = value + elif code == "NN1": + for index, value in enumerate(parse_ints(payload)[: cfg.k1], start=1): + cfg.nn1[index] = value + elif code == "NN2": + for index, value in enumerate(parse_ints(payload)[: cfg.k2], start=1): + cfg.nn2[index] = value + elif code == "NN3": + for index, value in enumerate(parse_ints(payload)[: cfg.k3], start=1): + cfg.nn3[index] = value + elif code == "IP1": + for index, value in enumerate(parse_ints(payload)[: cfg.k1], start=1): + cfg.ip1[index] = value + elif code == "IP2": + for index, value in enumerate(parse_ints(payload)[: cfg.k2], start=1): + cfg.ip2[index] = value + elif code == "IP3": + for index, value in enumerate(parse_ints(payload)[: cfg.k3], start=1): + cfg.ip3[index] = value + elif code == "FD": + values = parse_numbers(payload) + if values: + cfg.fd = values[0] + elif code == "AMM": + values = parse_numbers(payload) + if values: + cfg.amassm = values[0] + elif code == "AME": + values = parse_numbers(payload) + if values: + cfg.amasse = values[0] + elif code == "Z": + values = parse_numbers(payload) + if values: + cfg.z = values[0] + elif code == "ZS": + values = parse_numbers(payload) + if len(values) >= 3: + cfg.zsk, cfg.zsl, cfg.zsm = values[:3] + elif code == "M1": + for index, value in enumerate(parse_ints(payload)[: cfg.k1], start=1): + cfg.m1[index] = value + elif code == "M2": + for index, value in enumerate(parse_ints(payload)[: cfg.k2], start=1): + cfg.m2[index] = value + elif code == "M3": + for index, value in enumerate(parse_ints(payload)[: cfg.k3], start=1): + cfg.m3[index] = value + elif code == "POP": + for index, value in enumerate(parse_numbers(payload)[:6], start=1): + cfg.pop[index] = min(max(value, 0.0), 1.0) + elif code == "EHI": + values = parse_numbers(payload) + if values: + cfg.ehigh = values[0] + elif code == "ELO": + values = parse_numbers(payload) + if values: + cfg.elow = values[0] + elif code == "CLM": + values = parse_numbers(payload) + if values: + cfg.climit = values[0] + elif code == "ERS": + values = parse_numbers(payload) + if values: + cfg.eres = values[0] + elif code == "EAB": + values = parse_numbers(payload) + if len(values) >= 2: + cfg.ea, cfg.eb = values[:2] + elif code == "A": + values = parse_numbers(payload) + if values: + cfg.a = values[0] + elif code == "CT": + values = parse_numbers(payload) + if len(values) >= 2: + cfg.cfm, cfg.tfm = values[:2] + elif code == "STP": + values = parse_numbers(payload) + if len(values) >= 2: + cfg.step, cfg.rmatch = values[:2] + elif code == "KWD": + values = parse_numbers(payload) + if values: + cfg.widthk = values[0] + elif code == "NOP": + values = parse_ints(payload) + if values: + cfg.nopt = values[0] + elif code == "NMX": + values = parse_numbers(payload) + if values: + cfg.nmax = int(round(values[0])) + if len(values) >= 2 and cfg.nopt < 1: + cfg.alexp = values[1] + elif code == "PL": + values = parse_numbers(payload) + if len(values) >= 2: + level = int(round(values[0])) + if 0 <= level <= 19: + cfg.pl[level + 1] = values[1] + elif code == "DIR": + values = parse_numbers(payload) + if len(values) >= 4: + nstate = int(round(values[0])) + kappa = int(round(values[1])) + vacuum = values[2] + binding = values[3] + if vacuum < 0.0: + binding = binding + vacuum + cfg.energy[nstate][kappa] = binding + vacuum + elif code == "NPL": + for index, value in enumerate(parse_ints(payload)[:20], start=1): + cfg.npol[index] = value + elif code == "IPL": + values = parse_ints(payload) + if values: + cfg.ipol = values[0] + elif code == "IDB": + values = parse_ints(payload) + if values: + cfg.idb = values[0] + elif code == "YC": + for index, value in enumerate(parse_numbers(payload)[:4], start=1): + cfg.yc[index] = value + elif code == "IPC": + for index, value in enumerate(parse_ints(payload)[:3], start=1): + cfg.ipc[index] = value + elif code == "CL": + values = parse_numbers(payload) + if len(values) >= 2: + cfg.cl1, cfg.cl2 = values[:2] + elif code == "ESP": + values = parse_numbers(payload) + if values: + cfg.esp = values[0] + elif code == "IDE": + values = parse_ints(payload) + if values: + cfg.ide = values[0] + elif code == "JTM": + for index, value in enumerate(parse_ints(payload)[:6], start=1): + cfg.jtm[index] = value + elif code == "JTD": + for index, value in enumerate(parse_ints(payload)[:6], start=1): + cfg.jtd[index] = value + elif code == "JTQ": + for index, value in enumerate(parse_ints(payload)[:6], start=1): + cfg.jtq[index] = value + elif code == "JTO": + for index, value in enumerate(parse_ints(payload)[:6], start=1): + cfg.jto[index] = value + elif code == "PLN": + values = parse_numbers(payload) + if len(values) >= 4: + n8 = int(round(values[0])) + ld8 = int(round(values[1])) + lu8 = int(round(values[2])) + a8 = values[3] + entries = values[4:] + count = lu8 - ld8 + 1 + total = 0.0 + for offset in range(count): + if offset >= len(entries): + break + index = state_index(n8, ld8 + offset) + cfg.pln[index] = entries[offset] + total += entries[offset] + scale = a8 if a8 > 0.0 else total + normalizer = max(total, 1.0e-20) + for offset in range(count): + if offset >= len(entries): + break + index = state_index(n8, ld8 + offset) + cfg.pln[index] = cfg.pln[index] * scale / normalizer + elif code == "IP": + values = parse_ints(payload) + if values: + cfg.ip8 = values[0] + else: + cfg.warnings.append(f"Ignored unsupported card {code}") + + return None + + +def parse_first_case(deck_text: str) -> DeckConfig: + cfg = DeckConfig() + for raw_line in deck_text.splitlines(): + if raw_line.strip() == "": + continue + code = raw_line[:3] + payload = raw_line[10:] if len(raw_line) > 10 else "" + action = apply_card(cfg, code, payload) + if action == "execute": + return cfg + if action == "stop": + break + raise SystemExit("No XEQ card found in the input deck.") + + +def capture_config(cfg: DeckConfig) -> dict[str, object]: + if cfg.ip8 != 0: + weights: list[dict[str, object]] = [] + for n in range(1, cfg.nmax + 1): + for l in range(n): + weight = cfg.pln[state_index(n, l)] + if abs(weight) > 0.0: + weights.append({"n": n, "l": l, "weight": weight}) + return {"mode": "explicit_nl", "n_max": cfg.nmax, "nl_weights": weights} + if cfg.nopt == 0: + return {"mode": "statistical_l", "n_max": cfg.nmax, "alpha": cfg.alexp} + if cfg.nopt == 2: + return { + "mode": "quadratic_l", + "n_max": cfg.nmax, + "quadratic_coefficients": [cfg.cl1, cfg.cl2], + } + if cfg.nopt == 4: + return {"mode": "legacy_empty", "n_max": cfg.nmax} + return { + "mode": "explicit_l", + "n_max": cfg.nmax, + "l_weights": [cfg.pl[index] for index in range(1, cfg.nmax + 1)], + } + + +def dirac_energies(cfg: DeckConfig) -> list[dict[str, object]]: + entries: list[dict[str, object]] = [] + for n in range(1, min(cfg.nmax, len(cfg.energy) - 1) + 1): + for kappa in range(1, len(cfg.energy[n])): + value = cfg.energy[n][kappa] + if value > 0.0: + entries.append( + { + "n": n, + "kappa": kappa, + "vacuum_polarization_kev": 0.0, + "binding_kev": value, + } + ) + return entries + + +def convert(deck_path: Path, case_name: str | None) -> dict[str, object]: + cfg = parse_first_case(deck_path.read_text()) + payload: dict[str, object] = { + "schema_version": 1, + "metadata": {"case_name": case_name or deck_path.stem}, + "atom": { + "atomic_number": cfg.z, + "effective_shell_charges": [cfg.zsk, cfg.zsl, cfg.zsm], + "binding_energies_ev": [cfg.be[1], cfg.be[2], cfg.be[3]], + "atomic_mass": cfg.a, + "exact_mass_number": cfg.amassa if cfg.amassa > 0.0 else None, + }, + "masses": { + "muon_electron_masses": cfg.amassm, + "electron_mass_ev": cfg.amasse, + "nucleon_mass_mev": cfg.amassn, + }, + "transitions": { + "two_p_to_one_s_energy_ev": cfg.d2p1s if cfg.d2p1s > 0.0 else None, + "two_s_to_two_p_split_ev": cfg.esp if cfg.esp > 0.0 else None, + "dirac_energies": dirac_energies(cfg), + }, + "capture": capture_config(cfg), + "channels": { + "case_counts": [cfg.k0, cfg.k1, cfg.k2, cfg.k3], + "monopole_shells": [cfg.nn0[index] for index in range(1, cfg.k0 + 1)], + "dipole_shells": [cfg.nn1[index] for index in range(1, cfg.k1 + 1)], + "quadrupole_shells": [cfg.nn2[index] for index in range(1, cfg.k2 + 1)], + "octupole_shells": [cfg.nn3[index] for index in range(1, cfg.k3 + 1)], + "dipole_subshell_channels": [cfg.m1[index] for index in range(1, cfg.k1 + 1)], + "quadrupole_subshell_channels": [cfg.m2[index] for index in range(1, cfg.k2 + 1)], + "octupole_subshell_channels": [cfg.m3[index] for index in range(1, cfg.k3 + 1)], + "dipole_penetration_codes": [cfg.ip1[index] for index in range(1, cfg.k1 + 1)], + "quadrupole_penetration_codes": [cfg.ip2[index] for index in range(1, cfg.k2 + 1)], + "octupole_penetration_codes": [cfg.ip3[index] for index in range(1, cfg.k3 + 1)], + "dipole_penetration_avg_n_cutoffs": [cfg.iq1[index] for index in range(1, cfg.k1 + 1)], + "quadrupole_penetration_avg_n_cutoffs": [cfg.iq2[index] for index in range(1, cfg.k2 + 1)], + "octupole_penetration_avg_n_cutoffs": [cfg.iq3[index] for index in range(1, cfg.k3 + 1)], + }, + "shell_model": { + "subshell_populations": [cfg.pop[index] for index in range(1, 7)], + "refill_codes": [cfg.ipc[index] for index in range(1, 4)], + "penetration_cutoffs": [cfg.yc[index] for index in range(1, 5)], + "width_k_ev": cfg.widthk, + "track_polarization": cfg.ipol == 0, + }, + "reporting": { + "line_energy_min_mev": cfg.elow, + "line_energy_max_mev": cfg.ehigh, + "line_intensity_threshold": cfg.climit, + "energy_resolution_mev": cfg.eres, + }, + "model": {"factorial_divider": cfg.fd}, + "numerics": {"matrix_element_precision_digits": 120}, + } + if cfg.warnings: + payload["translator_warnings"] = cfg.warnings + return payload + + +def main() -> None: + parser = argparse.ArgumentParser(description="Translate a legacy cascade card deck into the MOCCA JSON input format.") + parser.add_argument("deck", type=Path, help="Legacy input deck") + parser.add_argument("--output", type=Path, help="Output JSON path. Defaults to stdout.") + parser.add_argument("--case-name", help="Optional case name override") + args = parser.parse_args() + + payload = json.dumps(convert(args.deck, args.case_name), indent=2) + "\n" + if args.output is None: + print(payload, end="") + else: + args.output.write_text(payload) + + +if __name__ == "__main__": + main()