pax_global_header00006660000000000000000000000064146640662670014533gustar00rootroot0000000000000052 comment=769fbfa1b53d300b099a5980c3fc144f3f480cff mctc-lib-0.3.2/000077500000000000000000000000001466406626700132275ustar00rootroot00000000000000mctc-lib-0.3.2/.codecov.yml000066400000000000000000000000631466406626700154510ustar00rootroot00000000000000fixes: - "/home/runner/work/mctc-lib/mctc-lib::" mctc-lib-0.3.2/.github/000077500000000000000000000000001466406626700145675ustar00rootroot00000000000000mctc-lib-0.3.2/.github/dco.yml000066400000000000000000000000321466406626700160520ustar00rootroot00000000000000require: members: false mctc-lib-0.3.2/.github/workflows/000077500000000000000000000000001466406626700166245ustar00rootroot00000000000000mctc-lib-0.3.2/.github/workflows/build.yml000066400000000000000000000147571466406626700204640ustar00rootroot00000000000000name: CI on: [push, pull_request] env: BUILD_DIR: _build PIP_PACKAGES: >- meson cmake ninja gcovr LINUX_INTEL_COMPONENTS: >- intel-oneapi-compiler-fortran-2021.2.0 intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-2021.2.0 intel-oneapi-mkl-2021.2.0 intel-oneapi-mkl-devel-2021.2.0 jobs: build: runs-on: ${{ matrix.os }} strategy: fail-fast: false matrix: os: [ubuntu-latest, macos-latest] build: [meson, cmake] build-type: [debug] compiler: [gnu] version: [12] include: - os: ubuntu-latest build: fpm build-type: debug compiler: gnu version: 12 - os: ubuntu-latest build: meson build-type: debug compiler: gnu version: 10 - os: ubuntu-latest build: meson build-type: coverage compiler: gnu version: 11 - os: ubuntu-latest build: meson build-type: debug compiler: intel version: 2021 defaults: run: shell: ${{ matrix.shell || 'bash' }} env: FC: ${{ matrix.compiler == 'intel' && 'ifort' || 'gfortran' }} CC: ${{ matrix.compiler == 'intel' && 'icc' || 'gcc' }} GCC_V: ${{ matrix.version }} PYTHON_V: 3.9 OMP_NUM_THREADS: 1,2,1 steps: - name: Checkout code uses: actions/checkout@v4 - uses: actions/setup-python@v5 with: python-version: ${{ env.PYTHON_V }} - name: Link pre-installed GCC and FC (macOS) if: ${{ contains(matrix.os, 'macos') && matrix.compiler == 'gnu' }} run: | gfortran_path=$( which gfortran-${{ env.GCC_V }} ) gcc_path=$( which gcc-${{ env.GCC_V }} ) gplusplus_path=$( which g++-${{ env.GCC_V }} ) export FC=$gfortran_path export CC=$gcc_path export CXX=$gplusplus_path ln -s $gfortran_path /usr/local/bin/gfortran ln -s $gcc_path /usr/local/bin/gcc ln -s $gplusplus_path /usr/local/bin/g++ - name: Install GCC (Linux) if: ${{ contains(matrix.os, 'ubuntu') && matrix.compiler == 'gnu' }} run: | sudo add-apt-repository ppa:ubuntu-toolchain-r/test sudo apt-get update sudo apt-get install -y gcc-${{ env.GCC_V}} gfortran-${{ env.GCC_V }} sudo update-alternatives \ --install /usr/bin/gcc gcc /usr/bin/gcc-${{ env.GCC_V }} 100 \ --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-${{ env.GCC_V }} \ --slave /usr/bin/gcov gcov /usr/bin/gcov-${{ env.GCC_V }} - name: Install fpm if: ${{ matrix.build == 'fpm' }} uses: fortran-lang/setup-fpm@v5 with: github-token: ${{ secrets.GITHUB_TOKEN }} - name: Prepare for cache restore if: ${{ matrix.compiler == 'intel' }} run: | sudo mkdir -p /opt/intel sudo chown $USER /opt/intel - name: Cache Intel install if: ${{ matrix.compiler == 'intel' }} id: cache-install uses: actions/cache@v2 with: path: /opt/intel/oneapi key: install-${{ matrix.compiler }}-${{ matrix.version }}-${{ matrix.os }} - name: Install Intel (Linux) if: ${{ contains(matrix.os, 'ubuntu') && contains(matrix.compiler, 'intel') && steps.cache-install.outputs.cache-hit != 'true' }} run: | wget https://apt.repos.intel.com/intel-gpg-keys/${{ env.KEY }} sudo apt-key add ${{ env.KEY }} rm ${{ env.KEY }} echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update sudo apt-get install ${{ env.PKG }} env: KEY: GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB PKG: ${{ env.LINUX_INTEL_COMPONENTS }} - name: Setup Intel oneAPI environment if: ${{ matrix.compiler == 'intel' }} run: | source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV - name: Install build and test dependencies if: ${{ ! contains(matrix.os, 'windows') }} run: pip3 install ${{ env.PIP_PACKAGES }} - name: Configure build (meson) if: ${{ matrix.build == 'meson' }} run: >- meson setup ${{ env.BUILD_DIR }} --buildtype=debug --prefix=$PWD/_dist --libdir=lib --warnlevel=0 -Db_coverage=${{ env.COVERAGE }} ${{ env.MESON_ARGS }} env: COVERAGE: ${{ matrix.build-type == 'coverage' }} MESON_ARGS: >- ${{ matrix.compiler == 'intel' && '-Dfortran_link_args=-qopenmp' || '' }} - name: Configure build (CMake) if: ${{ matrix.build == 'cmake' }} run: >- cmake -B${{ env.BUILD_DIR }} -GNinja -DCMAKE_BUILD_TYPE=Debug -DCMAKE_INSTALL_PREFIX=$PWD/_dist -DCMAKE_INSTALL_LIBDIR=lib -DCMAKE_FORTRAN_COMPILER=${{ env.FC }} - name: Build library (fpm) if: ${{ matrix.build == 'fpm' }} run: fpm build - name: Build library if: ${{ matrix.build != 'fpm' }} run: ninja -C ${{ env.BUILD_DIR }} - name: Run unit tests (fpm) if: ${{ matrix.build == 'fpm' }} run: fpm test - name: Run unit tests (meson) if: ${{ matrix.build == 'meson' }} run: | meson test -C ${{ env.BUILD_DIR }} --print-errorlogs --no-rebuild - name: Run unit tests (ctest) if: ${{ matrix.build == 'cmake' }} run: | ctest --output-on-failure --parallel 2 working-directory: ${{ env.BUILD_DIR }} - name: Create coverage report if: ${{ matrix.build == 'meson' && matrix.build-type == 'coverage' }} run: ninja -C ${{ env.BUILD_DIR }} coverage - name: Install project if: ${{ matrix.build != 'fpm' }} run: | ninja -C ${{ env.BUILD_DIR }} install echo "MCTCLIB_PREFIX=$PWD/_dist" >> $GITHUB_ENV - name: Create package if: ${{ matrix.build == 'meson' }} run: | tar cvf ${{ env.OUTPUT }} _dist xz -T0 ${{ env.OUTPUT }} echo "MCTCLIB_OUTPUT=${{ env.OUTPUT }}.xz" >> $GITHUB_ENV env: OUTPUT: mctc-lib-${{ matrix.compiler }}-${{ matrix.version }}-${{ matrix.os }}.tar - name: Upload package if: ${{ matrix.build == 'meson' && matrix.build-type != 'coverage' }} uses: actions/upload-artifact@v2 with: name: ${{ env.MCTCLIB_OUTPUT }} path: ${{ env.MCTCLIB_OUTPUT }} - name: Upload coverage report if: ${{ matrix.build == 'meson' && matrix.build-type == 'coverage' }} uses: codecov/codecov-action@v4 mctc-lib-0.3.2/.github/workflows/docs.yml000066400000000000000000000012461466406626700203020ustar00rootroot00000000000000name: docs on: [push, pull_request] jobs: build-and-deploy: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - uses: actions/setup-python@v1 with: python-version: '3.x' - name: Install dependencies run: pip install ford - name: Build Documentation run: ford docs.md - uses: JamesIves/github-pages-deploy-action@3.7.1 if: github.event_name == 'push' && github.repository == 'grimme-lab/mctc-lib' && ( startsWith( github.ref, 'refs/tags/' ) || github.ref == 'refs/heads/main' ) with: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} BRANCH: gh-pages FOLDER: _docs CLEAN: true mctc-lib-0.3.2/.gitignore000066400000000000000000000004631466406626700152220ustar00rootroot00000000000000# Prerequisites *.d # Compiled Object files *.slo *.lo *.o *.obj # Precompiled Headers *.gch *.pch # Compiled Dynamic libraries *.so *.dylib *.dll # Fortran module files *.mod *.smod # Compiled Static libraries *.lai *.la *.a *.lib # Executables *.exe *.out *.app # Directories /build*/ /_*/ /docs*/ mctc-lib-0.3.2/CMakeLists.txt000066400000000000000000000056561466406626700160030ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. cmake_minimum_required(VERSION 3.14) project( "mctc-lib" LANGUAGES "Fortran" VERSION "0.3.2" DESCRIPTION "Modular computation tool chain" ) # Follow GNU conventions for installing directories include(GNUInstallDirs) # General configuration information add_subdirectory("config") # Dependencies if(NOT TARGET "jsonfortran::jsonfortran" AND WITH_JSON) find_package("jsonfortran" REQUIRED) endif() # Collect source of the project set(srcs) add_subdirectory("src") # MCTC library target add_library( "${PROJECT_NAME}-lib" "${srcs}" ) target_compile_definitions( "${PROJECT_NAME}-lib" PRIVATE "WITH_JSON=$" ) if(WITH_OpenMP) find_package(OpenMP REQUIRED) target_link_libraries( "${PROJECT_NAME}-lib" PRIVATE OpenMP::OpenMP_Fortran ) endif() if(WITH_JSON) target_link_libraries( "${PROJECT_NAME}-lib" PRIVATE "jsonfortran::jsonfortran" ) endif() set_target_properties( "${PROJECT_NAME}-lib" PROPERTIES POSITION_INDEPENDENT_CODE TRUE OUTPUT_NAME "${PROJECT_NAME}" VERSION "${PROJECT_VERSION}" SOVERSION "${PROJECT_VERSION_MAJOR}" Fortran_MODULE_DIRECTORY "${PROJECT_BINARY_DIR}/include" ) target_include_directories( "${PROJECT_NAME}-lib" PUBLIC $ $ $ $ ) if(NOT EXISTS "${PROJECT_BINARY_DIR}/include") file(MAKE_DIRECTORY "${PROJECT_BINARY_DIR}/include") endif() # Add example application add_subdirectory("app") # Export targets for other projects add_library("${PROJECT_NAME}" INTERFACE) target_link_libraries("${PROJECT_NAME}" INTERFACE "${PROJECT_NAME}-lib") install( TARGETS "${PROJECT_NAME}" "${PROJECT_NAME}-lib" EXPORT "${PROJECT_NAME}-targets" LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}" ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}" ) install( EXPORT "${PROJECT_NAME}-targets" NAMESPACE "${PROJECT_NAME}::" DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}" ) install( DIRECTORY "${PROJECT_BINARY_DIR}/include/" DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}/${module-dir}" ) # Package license files install( FILES "LICENSE" DESTINATION "${CMAKE_INSTALL_DATADIR}/licenses/${PROJECT_NAME}" ) # add the testsuite enable_testing() add_subdirectory("test") mctc-lib-0.3.2/LICENSE000066400000000000000000000261361466406626700142440ustar00rootroot00000000000000 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. mctc-lib-0.3.2/README.md000066400000000000000000000152231466406626700145110ustar00rootroot00000000000000# Modular computation tool chain library [![Apache-2.0](https://img.shields.io/github/license/grimme-lab/mctc-lib)](LICENSE) [![Release](https://img.shields.io/github/v/release/grimme-lab/mctc-lib)](https://github.com/grimme-lab/mctc-lib/releases/latest) [![CI](https://github.com/grimme-lab/mctc-lib/workflows/CI/badge.svg)](https://github.com/grimme-lab/mctc-lib/actions) [![docs](https://github.com/grimme-lab/mctc-lib/workflows/docs/badge.svg)](https://grimme-lab.github.io/mctc-lib) [![codecov](https://codecov.io/gh/grimme-lab/mctc-lib/branch/main/graph/badge.svg)](https://codecov.io/gh/grimme-lab/mctc-lib) ## Installation To build this project from the source code in this repository you need to have a Fortran compiler supporting Fortran 2008 and one of the supported build systems: - [meson](https://mesonbuild.com) version 0.55 or newer, with a build-system backend, *i.e.* [ninja](https://ninja-build.org) version 1.7 or newer - [cmake](https://cmake.org) version 3.14 or newer, with a build-system backend, *i.e.* [ninja](https://ninja-build.org) version 1.10 or newer - [fpm](https://github.com/fortran-lang/fpm) version 0.3.0 or newer Currently this project supports GCC, Intel and PGI/NVHPC compilers. ### Building with meson Setup a build with ``` meson setup _build ``` You can select the Fortran compiler by the `FC` environment variable. To compile the project run ``` meson compile -C _build ``` You can run the projects testsuite with ``` meson test -C _build --print-errorlogs ``` To include ``mctc-lib`` in your project add the following wrap file to your subprojects directory: ```ini [wrap-git] directory = mctc-lib url = https://github.com/grimme-lab/mctc-lib revision = head ``` You can retrieve the dependency from the wrap fallback with ```meson mctc_dep = dependency('mctc-lib', fallback: ['mctc-lib', 'mctc_dep']) ``` and add it as dependency to your targets. ### Building with CMake Alternatively, this project can be build with CMake (in this case ninja 1.10 or newer is required): ``` cmake -B _build -G Ninja ``` To compile the project with CMake run ``` cmake --build _build ``` You can run the project testsuite with ``` pushd _build && ctest && popd ``` To include ``mctc-lib`` in your CMake project retrieve it using the ``FetchContent`` module: ```cmake if(NOT TARGET mctc-lib) set("mctc-lib-url" "https://github.com/grimme-lab/mctc-lib") message(STATUS "Retrieving mctc-lib from ${mctc-lib-url}") include(FetchContent) FetchContent_Declare( "mctc-lib" GIT_REPOSITORY "${mctc-lib-url}" GIT_TAG "HEAD" ) FetchContent_MakeAvailable("mctc-lib") endif() ``` And link against the ``"mctc-lib"`` interface library. ```cmake target_link_libraries("${PROJECT_NAME}-lib" PUBLIC "mctc-lib") ``` ### Building with fpm Invoke fpm in the project root with ``` fpm build ``` To run the testsuite use ``` fpm test ``` You can access the ``mctc-convert`` program using the run subcommand ``` fpm run -- --help ``` To use ``mctc-lib`` for testing include it as dependency in your package manifest ```toml [dependencies] mctc-lib.git = "https://github.com/grimme-lab/mctc-lib" ``` ## Example An example application is provided with the [``mctc-convert``](man/mctc-convert.1.adoc) program to convert between different supported input formats. To read an input file using the IO library use the ``read_structure`` routine. The final geometry data is stored in a ``structure_type``: ```fortran use mctc_io use mctc_env type(structure_type) :: mol type(error_type), allocatable :: error call read_structure(mol, "input.xyz", error) if (allocated(error)) then print '(a)', error%message error stop end if ``` The environment library provides a basic error back-propagation mechanism using an allocatable ``error_type``, which is passed to the library routines. Usually the reader can detect the file type from the suffix of file names. Alternatively, the ``filetype`` enumerator provides the identifiers of all supported file types, which can be passed as optional argument to the ``read_structure`` routine. In a similar way the ``write_structure`` routine allows to write a ``structure_type`` to a file or unit: ``` fortran use mctc_io use mctc_env type(structure_type) :: mol type(error_type), allocatable :: error call write_structure(mol, "output.xyz", error) if (allocated(error)) then print '(a)', error%message error stop end if ``` The [``mctc-convert``](man/mctc-convert.1.adoc) program provides a chained reader and writer call to act as a geometry file converter. Checkout the implementation in [``app/main.f90``](app/main.f90). ## Error reporting The geometry input readers try to be provide helpful error messages, no user should be left alone with an error message like *invalid input*. Unclear error messages are considered a bug in *mctc-lib*, if you struggle to make sense of a reported error, file us an issue and we will make the report better. **How can helpful error messages look like?** Here are some examples. 1. negative number of atoms declared in xyz file ``` Error: Impossible number of atoms provided --> struc.xyz:1:1-2 | 1 | -3 | ^^ expected positive integer value | ``` 2. total charge is not specified as integer ``` Error: Cannot read eht entry --> struc.coord:18:13-15 | 18 | $eht charge=one unpaired=0 | ^^^ expected integer value | ``` 3. a fixed width entry contains an incorrect value ``` Error: Cannot read charges --> struc.mol:29:23-25 | 29 | M CHG 3 1 1 3 b 2 -1 | ^^^ expected integer value | ``` 4. Turbomole input with conflicting data groups ``` Error: Conflicting lattice and cell groups --> struc.coord:37:1-5 | 35 | $lattice angs | -------- lattice first defined here : 37 | $cell angs | ^^^^^ conflicting cell group | ``` We try to retain as much information as possible when displaying the error message to make it easy to fix the offending part in the input. ## License Licensed under the Apache License, Version 2.0 (the “License”); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an *“as is” basis*, *without warranties or conditions of any kind*, either express or implied. See the License for the specific language governing permissions and limitations under the License. Unless you explicitly state otherwise, any contribution intentionally submitted for inclusion in this project by you, as defined in the Apache-2.0 license, shall be licensed as above, without any additional terms or conditions. mctc-lib-0.3.2/app/000077500000000000000000000000001466406626700140075ustar00rootroot00000000000000mctc-lib-0.3.2/app/CMakeLists.txt000066400000000000000000000014061466406626700165500ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. add_executable( "mctc-convert" "main.f90" ) target_link_libraries( "mctc-convert" PRIVATE "mctc-lib" ) install( TARGETS "mctc-convert" DESTINATION "${CMAKE_INSTALL_BINDIR}" ) mctc-lib-0.3.2/app/main.f90000066400000000000000000000254611466406626700152630ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Example application using tool chain library. !> !> This program uses the [[read_structure]] and [[write_structure]] procedures !> to implement a structure converter. !> Usually, the input structure can be inferred by the name of the input file. !> To allow formats with non-standard extensions (because most geometry formats !> are not really standardized) additional hints can be passed by the command !> line to determine the read/write formats. !> !> To add support for piping standard input and standard output reading and !> writing from units is combined with the additional format hints. !> !> Additional filters or modifications can also be implemented in an intermediary !> step, this program implements an element symbol normalization. Other filters !> like folding back to central cells or removing lattice vector could be added !> in a similar manner. program main use, intrinsic :: iso_fortran_env, only : output_unit, error_unit, input_unit use mctc_env, only : error_type, fatal_error, get_argument, wp use mctc_io, only : structure_type, read_structure, write_structure, & & filetype, get_filetype, to_symbol use mctc_version, only : get_mctc_version implicit none character(len=*), parameter :: prog_name = "mctc-convert" character(len=:), allocatable :: input, output, template, filename integer, allocatable :: input_format, output_format, template_format type(structure_type) :: mol type(structure_type), allocatable :: mol_template type(error_type), allocatable :: error logical :: normalize, read_dot_files integer :: charge, unpaired call get_arguments(input, input_format, output, output_format, normalize, & & template, template_format, read_dot_files, error) if (allocated(error)) then write(error_unit, '(a)') error%message error stop end if if (allocated(template)) then allocate(mol_template) if (template == "-") then if (.not.allocated(template_format)) then template_format = merge(output_format, filetype%xyz, allocated(output_format)) end if call read_structure(mol_template, input_unit, template_format, error) else call read_structure(mol_template, template, error, template_format) end if if (allocated(error)) then write(error_unit, '(a)') error%message error stop end if end if if (input == "-") then if (.not.allocated(input_format)) input_format = filetype%xyz call read_structure(mol, input_unit, input_format, error) else call read_structure(mol, input, error, input_format) if (read_dot_files) then charge = nint(mol%charge) if (.not.allocated(error)) then filename = join(dirname(input), ".CHRG") if (exists(filename)) call read_file(filename, charge, error) end if mol%charge = charge unpaired = mol%uhf if (.not.allocated(error)) then filename = join(dirname(input), ".UHF") if (exists(filename)) call read_file(filename, unpaired, error) end if mol%uhf = unpaired end if end if if (allocated(error)) then write(error_unit, '(a)') error%message error stop end if if (allocated(mol_template)) then if (mol%nat /= mol_template%nat) then write(error_unit, '(*(a, 1x))') & "Number of atoms missmatch in", template, "and", input error stop end if ! move_alloc can also move non-allocated objects call move_alloc(mol_template%lattice, mol%lattice) call move_alloc(mol_template%periodic, mol%periodic) call move_alloc(mol_template%bond, mol%bond) call move_alloc(mol_template%comment, mol%comment) call move_alloc(mol_template%pdb, mol%pdb) call move_alloc(mol_template%sdf, mol%sdf) end if if (normalize) then mol%sym = to_symbol(mol%num) end if if (output == "-") then if (.not.allocated(output_format)) output_format = filetype%xyz call write_structure(mol, output_unit, output_format, error) else call write_structure(mol, output, error, output_format) end if if (allocated(error)) then write(error_unit, '(a)') error%message error stop end if contains subroutine help(unit) integer, intent(in) :: unit write(unit, '(a, *(1x, a))') & "Usage: "//prog_name//" [options] " write(unit, '(a)') & "", & "Read structure from input file and writes it to output file.", & "The format is determined by the file extension or the format hint", & "" write(unit, '(2x, a, t25, a)') & "-i, --input ", "Hint for the format of the input file", & "-o, --output ", "Hint for the format of the output file", & "--normalize", "Normalize all element symbols to capitalized format", & "--template ", "File to use as template to fill in meta data", & "", "(useful to add back SDF or PDB annotions)", & "--template-format ", "", "", "Hint for the format of the template file", & "--ignore-dot-files", "Do not read charge and spin from .CHRG and .UHF files", & "--version", "Print program version and exit", & "--help", "Show this help message" write(unit, '(a)') end subroutine help subroutine version(unit) integer, intent(in) :: unit character(len=:), allocatable :: version_string call get_mctc_version(string=version_string) write(unit, '(a, *(1x, a))') & & prog_name, "version", version_string end subroutine version subroutine get_arguments(input, input_format, output, output_format, normalize, & & template, template_format, read_dot_files, error) !> Input file name character(len=:), allocatable :: input !> Input file format integer, allocatable, intent(out) :: input_format !> Output file name character(len=:), allocatable :: output !> Output file format integer, allocatable, intent(out) :: output_format !> Template file name character(len=:), allocatable :: template !> Template file format integer, allocatable, intent(out) :: template_format !> Normalize element symbols logical, intent(out) :: normalize !> Read information from .CHRG and .UHF files logical, intent(out) :: read_dot_files !> Error handling type(error_type), allocatable, intent(out) :: error integer :: iarg, narg character(len=:), allocatable :: arg normalize = .false. read_dot_files = .true. iarg = 0 narg = command_argument_count() do while(iarg < narg) iarg = iarg + 1 call get_argument(iarg, arg) select case(arg) case("--help") call help(output_unit) stop case("--version") call version(output_unit) stop case default if (.not.allocated(input)) then call move_alloc(arg, input) cycle end if if (.not.allocated(output)) then call move_alloc(arg, output) cycle end if call fatal_error(error, "Too many positional arguments present") exit case("-i", "--input") iarg = iarg + 1 call get_argument(iarg, arg) if (.not.allocated(arg)) then call fatal_error(error, "Missing argument for input format") exit end if if (index(arg, ".") == 0) arg = "."//arg input_format = get_filetype(arg) case("-o", "--output") iarg = iarg + 1 call get_argument(iarg, arg) if (.not.allocated(arg)) then call fatal_error(error, "Missing argument for output format") exit end if output_format = get_filetype("."//arg) case("--normalize") normalize = .true. case("--template") iarg = iarg + 1 call get_argument(iarg, template) if (.not.allocated(template)) then call fatal_error(error, "Missing argument for template file") exit end if case("--template-format") iarg = iarg + 1 call get_argument(iarg, arg) if (.not.allocated(arg)) then call fatal_error(error, "Missing argument for template format") exit end if template_format = get_filetype("."//arg) case("--ignore-dot-files") read_dot_files = .false. end select end do if (.not.(allocated(input).and.(allocated(output)))) then if (.not.allocated(error)) then call help(output_unit) error stop end if end if end subroutine get_arguments !> Extract dirname from path function dirname(filename) character(len=*), intent(in) :: filename character(len=:), allocatable :: dirname dirname = filename(1:scan(filename, "/\", back=.true.)) if (len_trim(dirname) == 0) dirname = "." end function dirname !> Construct path by joining strings with os file separator function join(a1, a2) result(path) use mctc_env_system, only : is_windows character(len=*), intent(in) :: a1, a2 character(len=:), allocatable :: path character :: filesep if (is_windows()) then filesep = '\' else filesep = '/' end if path = a1 // filesep // a2 end function join !> test if pathname already exists function exists(filename) character(len=*), intent(in) :: filename logical :: exists inquire(file=filename, exist=exists) end function exists subroutine read_file(filename, val, error) use mctc_io_utils, only : next_line, read_next_token, io_error, token_type character(len=*), intent(in) :: filename integer, intent(out) :: val type(error_type), allocatable, intent(out) :: error integer :: io, stat, lnum, pos type(token_type) :: token character(len=:), allocatable :: line lnum = 0 open(file=filename, newunit=io, status='old', iostat=stat) if (stat /= 0) then call fatal_error(error, "Error: Could not open file '"//filename//"'") return end if call next_line(io, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, val, stat) if (stat /= 0) then call io_error(error, "Cannot read value from file", line, token, & filename, lnum, "expected integer value") return end if close(io, iostat=stat) end subroutine read_file end program main mctc-lib-0.3.2/app/meson.build000066400000000000000000000013031466406626700161460ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. mctc_convert_exe = executable( 'mctc-convert', sources: files('main.f90'), dependencies: mctc_dep, install: install, ) mctc-lib-0.3.2/config/000077500000000000000000000000001466406626700144745ustar00rootroot00000000000000mctc-lib-0.3.2/config/CMakeLists.txt000066400000000000000000000057171466406626700172460ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. option(BUILD_SHARED_LIBS "Whether the libraries built should be shared" FALSE) option(WITH_OpenMP "Enable support for shared memory parallelisation with OpenMP" TRUE) option(WITH_JSON "Enable support for JSON parsing via json-fortran" FALSE) set( "${PROJECT_NAME}-module-dir" "${PROJECT_NAME}/modules" CACHE STRING "Subdirectory to install generated module files to" ) set( module-dir "${${PROJECT_NAME}-module-dir}" ) set(module-dir "${module-dir}" PARENT_SCOPE) list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/cmake") set(CMAKE_MODULE_PATH "${CMAKE_MODULE_PATH}" PARENT_SCOPE) install( DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}/cmake/" DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}" ) # Compiler-specific configurations if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI" OR CMAKE_Fortran_COMPILER_ID MATCHES "NVHPC" OR CMAKE_Fortran_COMPILER_ID MATCHES "Flang" ) set( CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mbackslash -Mallocatable=03" PARENT_SCOPE ) endif() # Set build type as CMake does not provide defaults if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) set( CMAKE_BUILD_TYPE "RelWithDebInfo" CACHE STRING "Build type to be used." FORCE ) message( STATUS "Setting build type to '${CMAKE_BUILD_TYPE}' as none was specified." ) endif() include(CMakePackageConfigHelpers) configure_package_config_file( "${CMAKE_CURRENT_SOURCE_DIR}/template.cmake" "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config.cmake" INSTALL_DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}" ) write_basic_package_version_file( "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config-version.cmake" VERSION "${PROJECT_VERSION}" COMPATIBILITY SameMinorVersion ) install( FILES "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config.cmake" "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config-version.cmake" DESTINATION "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}" ) if(BUILD_SHARED_LIBS) set(PKG_CONFIG_REQUIRES "Requires.private") else() set(PKG_CONFIG_REQUIRES "Requires") endif() if(WITH_JSON) set(PKG_CONFIG_REQUIREMENTS "json-fortran") else() set(PKG_CONFIG_REQUIREMENTS) endif() configure_file( "${CMAKE_CURRENT_SOURCE_DIR}/template.pc" "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc" @ONLY ) install( FILES "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc" DESTINATION "${CMAKE_INSTALL_LIBDIR}/pkgconfig" ) mctc-lib-0.3.2/config/cmake/000077500000000000000000000000001466406626700155545ustar00rootroot00000000000000mctc-lib-0.3.2/config/cmake/Findjsonfortran.cmake000066400000000000000000000021231466406626700217220ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. if(NOT TARGET "jsonfortran::jsonfortran") # json-fortran tries to make it hard to get found string(TOLOWER "jsonfortran-${CMAKE_Fortran_COMPILER_ID}" jsonfortran) find_package("${jsonfortran}" CONFIG) add_library("jsonfortran::jsonfortran" IMPORTED INTERFACE) target_link_libraries( "jsonfortran::jsonfortran" INTERFACE "jsonfortran$<$>:-static>" ) target_include_directories( "jsonfortran::jsonfortran" INTERFACE "${jsonfortran_INCLUDE_DIRS}" ) endif() mctc-lib-0.3.2/config/install-mod.py000077500000000000000000000025371466406626700173030ustar00rootroot00000000000000#!/usr/bin/env python3 # This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. from os import environ, listdir, makedirs from os.path import join, isdir, exists from sys import argv from shutil import copy build_dir = environ["MESON_BUILD_ROOT"] if "MESON_INSTALL_DESTDIR_PREFIX" in environ: install_dir = environ["MESON_INSTALL_DESTDIR_PREFIX"] else: install_dir = environ["MESON_INSTALL_PREFIX"] include_dir = argv[1] if len(argv) > 1 else "include" module_dir = join(install_dir, include_dir) modules = [] for d in listdir(build_dir): bd = join(build_dir, d) if isdir(bd): for f in listdir(bd): if f.endswith(".mod"): modules.append(join(bd, f)) if not exists(module_dir): makedirs(module_dir) for mod in modules: print("Installing", mod, "to", module_dir) copy(mod, module_dir) mctc-lib-0.3.2/config/meson.build000066400000000000000000000031201466406626700166320ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. os = host_machine.system() fc = meson.get_compiler('fortran') fc_id = fc.get_id() if fc_id == 'gcc' add_project_arguments( '-ffree-line-length-none', '-fbacktrace', language: 'fortran', ) elif fc_id == 'intel' add_project_arguments( '-traceback', language: 'fortran', ) elif fc_id == 'intel-cl' add_project_arguments( '-fpp', language: 'fortran', ) elif fc_id == 'pgi' or fc_id == 'nvidia_hpc' add_project_arguments( '-Mbackslash', '-Mallocatable=03', '-traceback', language: 'fortran', ) elif fc_id == 'flang' add_project_arguments( '-Mbackslash', '-Mallocatable=03', language: 'fortran', ) endif if get_option('openmp') omp_dep = dependency('openmp') lib_deps += omp_dep endif jsonfortran_dep = dependency( 'json-fortran', required: get_option('json'), fallback: ['json-fortran-8.2.5','jsonfortran_dep'], default_options: [ 'default_library=static', ], static: get_option('default_library') != 'dynamic', ) lib_deps += jsonfortran_dep mctc-lib-0.3.2/config/template.cmake000066400000000000000000000007731466406626700173200ustar00rootroot00000000000000@PACKAGE_INIT@ set("@PROJECT_NAME@_WITH_OpenMP" @WITH_OpenMP@) set("@PROJECT_NAME@_WITH_JSON" @WITH_JSON@) if(NOT TARGET "@PROJECT_NAME@::@PROJECT_NAME@") include("${CMAKE_CURRENT_LIST_DIR}/@PROJECT_NAME@-targets.cmake") include(CMakeFindDependencyMacro) if(NOT TARGET "OpenMP::OpenMP_Fortran" AND "@PROJECT_NAME@_WITH_OpenMP") find_dependency("OpenMP") endif() if(NOT TARGET "jsonfortran::jsonfortran" AND "@PROJECT_NAME@_WITH_JSON") find_dependency("jsonfortran") endif() endif() mctc-lib-0.3.2/config/template.pc000066400000000000000000000005231466406626700166330ustar00rootroot00000000000000prefix=@CMAKE_INSTALL_PREFIX@ libdir=${prefix}/@CMAKE_INSTALL_LIBDIR@ includedir=${prefix}/@CMAKE_INSTALL_INCLUDEDIR@ Name: @PROJECT_NAME@ Description: @PROJECT_DESCRIPTION@ @PKG_CONFIG_REQUIRES@: @PKG_CONFIG_REQUIREMENTS@ Version: @PROJECT_VERSION@ Libs: -L${libdir} -l@PROJECT_NAME@ Cflags: -I${includedir} -I${includedir}/@module-dir@ mctc-lib-0.3.2/doc/000077500000000000000000000000001466406626700137745ustar00rootroot00000000000000mctc-lib-0.3.2/doc/format-aims.md000066400000000000000000000073031466406626700165400ustar00rootroot00000000000000--- title: FHI-aims geometry.in format --- ## Specification Format used by FHI-aims program. Atoms are specified by ``atom`` or ``atom_frac`` keyword followed by three real numbers and an character identifier. Lattice parameters are given with the ``lattice_vector`` keyword followed by three real numbers. ## Example Caffeine molecule in xyz format ``` atom 1.07320000000000 0.04890000000000 -0.07570000000000 C atom 2.51370000000000 0.01260000000000 -0.07580000000000 N atom 3.35200000000000 1.09590000000000 -0.07530000000000 C atom 4.61900000000000 0.73030000000000 -0.07550000000000 N atom 4.57910000000000 -0.63140000000000 -0.07530000000000 C atom 3.30130000000000 -1.10260000000000 -0.07520000000000 C atom 2.98070000000000 -2.48690000000000 -0.07380000000000 C atom 1.82530000000000 -2.90040000000000 -0.07580000000000 O atom 4.11440000000000 -3.30430000000000 -0.06940000000000 N atom 5.45170000000000 -2.85620000000000 -0.07240000000000 C atom 6.38930000000000 -3.65970000000000 -0.07230000000000 O atom 5.66240000000000 -1.47680000000000 -0.07490000000000 N atom 7.00950000000000 -0.93650000000000 -0.07520000000000 C atom 3.92060000000000 -4.74090000000000 -0.06160000000000 C atom 0.73400000000000 1.08790000000000 -0.07500000000000 H atom 0.71240000000000 -0.45700000000000 0.82340000000000 H atom 0.71240000000000 -0.45580000000000 -0.97550000000000 H atom 2.99300000000000 2.11760000000000 -0.07480000000000 H atom 7.76530000000000 -1.72630000000000 -0.07590000000000 H atom 7.14860000000000 -0.32180000000000 0.81970000000000 H atom 7.14800000000000 -0.32080000000000 -0.96950000000000 H atom 2.86500000000000 -5.02320000000000 -0.05830000000000 H atom 4.40230000000000 -5.15920000000000 0.82840000000000 H atom 4.40020000000000 -5.16930000000000 -0.94780000000000 H ``` Carbondioxide in FHI-aims format: ``` atom 6.62447969041000 6.62412068645100 6.63464984519600 C atom 9.39832080661700 6.63600723231600 9.41199064870100 C atom 9.39627410479100 9.39525191972100 6.64954571641900 C atom 6.63330355605800 9.40242623362300 9.41005306161900 C atom 7.30170129847500 7.29939192380800 7.31169116419300 O atom 5.94599026584500 5.94975031040400 5.95798102153000 O atom 10.07176052646200 7.31493655623100 8.73491466703200 O atom 8.72441947117100 5.95679178597600 10.08835581093400 O atom 10.07139562176400 8.72199135754100 5.96845847998500 O atom 8.72031652030300 10.06826009498800 7.33005771988500 O atom 5.95443684368700 10.08070344665100 8.73771924611400 O atom 7.31154031517700 8.72379750503500 10.08265551999000 O lattice_vector 5.68032472285798 0.00000000000000 0.00000000000000 lattice_vector 0.00000000000000 5.68032472285798 0.00000000000000 lattice_vector 0.00000000000000 0.00000000000000 5.68032472285798 ``` ## Missing Features The implementation of this format is (to our knowledge) feature-complete. @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-cjson.md000066400000000000000000000067511466406626700167310ustar00rootroot00000000000000--- title: Chemical JSON --- ## Specification @Note [Reference](https://github.com/OpenChemistry/avogadrolibs/blob/master/avogadro/io/cjsonformat.cpp) Chemical JSON files are identified by the extension ``cjson`` and parsed following the format implemented in Avogadro 2. The entries *name*, *atoms.elements.number*, *atoms.coords.3d*, *atoms.coords.3d fractional*, *unit cell*, *atoms.formalCharges*, *bonds.connections.index*, and *bonds.order* are recognized by the reader. ## Example Caffeine molecule in ``qcschema_molecule`` format. ```json { "chemicalJson": 1, "atoms": { "elements": { "number": [ 6, 7, 6, 7, 6, 6, 6, 8, 7, 6, 8, 7, 6, 6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ] }, "coords": { "3d": [ 1.0731997649702911E+00, 4.8899989290949721E-02, -7.5699983421776973E-02, 2.5136994495022558E+00, 1.2599997240612813E-02, -7.5799983399877077E-02, 3.3519992659154081E+00, 1.0958997599990143E+00, -7.5299983509376570E-02, 4.6189989884436962E+00, 7.3029984006504256E-01, -7.5499983465576764E-02, 4.5790989971817559E+00, -6.3139986172404194E-01, -7.5299983509376570E-02, 3.3012992770186567E+00, -1.1025997585317211E+00, -7.5199983531276451E-02, 2.9806993472297307E+00, -2.4868994553714288E+00, -7.3799983837875047E-02, 1.8252996002611557E+00, -2.9003993648153492E+00, -7.5799983399877077E-02, 4.1143990989505834E+00, -3.3042992763616597E+00, -6.9399984801470568E-02, 5.4516988060832432E+00, -2.8561993744951040E+00, -7.2399984144473614E-02, 6.3892986007497967E+00, -3.6596991985294207E+00, -7.2299984166373524E-02, 5.6623987599401575E+00, -1.4767996765823013E+00, -7.4899983596976152E-02, 7.0094984649266268E+00, -9.3649979490745228E-01, -7.5199983531276451E-02, 3.9205991413925863E+00, -4.7408989617477202E+00, -6.1599986509662634E-02, 7.3399983925474632E-01, 1.0878997617510062E+00, -7.4999983575076257E-02, 7.1239984398512435E-01, -4.5699989991746470E-01, 8.2339981967623732E-01, 7.1239984398512435E-01, -4.5579990018026340E-01, -9.7549978636649193E-01, 2.9929993445360430E+00, 2.1175995362477531E+00, -7.4799983618876062E-02, 7.7652982994071955E+00, -1.7262996219420552E+00, -7.5899983377977168E-02, 7.1485984344638682E+00, -3.2179992952612718E-01, 8.1969982048653345E-01, 7.1479984345952676E+00, -3.2079992974512617E-01, -9.6949978768048573E-01, 2.8649993725679135E+00, -5.0231988999243073E+00, -5.8299987232359275E-02, 4.4022990359007768E+00, -5.1591988701404459E+00, 8.2839981858124223E-01, 4.4001990363606742E+00, -5.1692988679285561E+00, -9.4779979243276369E-01 ] } }, "bonds": { "connections": { "index": [ 0, 1, 1, 2, 2, 3, 3, 4, 1, 5, 4, 5, 5, 6, 6, 7, 6, 8, 8, 9, 9, 10, 4, 11, 9, 11, 11, 12, 8, 13, 0, 14, 0, 15, 0, 16, 2, 17, 12, 18, 12, 19, 12, 20, 13, 21, 13, 22, 13, 23 ] }, "order": [ 1, 4, 4, 4, 1, 4, 1, 2, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ] } } ``` ## Missing features The schema is not verified on completeness and not all data is stored in the final structure type. @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-ctfile.md000066400000000000000000000047501466406626700170600ustar00rootroot00000000000000--- title: Connection table format --- ## Specification @Note [Reference](https://www.daylight.com/meetings/mug05/Kappler/ctfile.pdf) The molfile is identified by the extension ``mol`` and the structure data format is identified by ``sdf``. Both V2000 and V3000 connection tables can be read. ## Example Caffeine molecule in mol format: ```text 11262021073D 24 0 0 0 0 999 V2000 1.0732 0.0488 -0.0757 C 0 0 0 0 0 0 0 0 0 0 0 0 2.5137 0.0126 -0.0758 N 0 0 0 0 0 0 0 0 0 0 0 0 3.3520 1.0959 -0.0753 C 0 0 0 0 0 0 0 0 0 0 0 0 4.6190 0.7303 -0.0755 N 0 0 0 0 0 0 0 0 0 0 0 0 4.5791 -0.6314 -0.0753 C 0 0 0 0 0 0 0 0 0 0 0 0 3.3013 -1.1026 -0.0752 C 0 0 0 0 0 0 0 0 0 0 0 0 2.9807 -2.4869 -0.0738 C 0 0 0 0 0 0 0 0 0 0 0 0 1.8253 -2.9004 -0.0758 O 0 0 0 0 0 0 0 0 0 0 0 0 4.1144 -3.3043 -0.0694 N 0 0 0 0 0 0 0 0 0 0 0 0 5.4517 -2.8562 -0.0723 C 0 0 0 0 0 0 0 0 0 0 0 0 6.3893 -3.6597 -0.0723 O 0 0 0 0 0 0 0 0 0 0 0 0 5.6624 -1.4768 -0.0749 N 0 0 0 0 0 0 0 0 0 0 0 0 7.0095 -0.9365 -0.0752 C 0 0 0 0 0 0 0 0 0 0 0 0 3.9206 -4.7409 -0.0616 C 0 0 0 0 0 0 0 0 0 0 0 0 0.7340 1.0879 -0.0750 H 0 0 0 0 0 0 0 0 0 0 0 0 0.7124 -0.4570 0.8233 H 0 0 0 0 0 0 0 0 0 0 0 0 0.7124 -0.4558 -0.9755 H 0 0 0 0 0 0 0 0 0 0 0 0 2.9930 2.1176 -0.0748 H 0 0 0 0 0 0 0 0 0 0 0 0 7.7653 -1.7263 -0.0759 H 0 0 0 0 0 0 0 0 0 0 0 0 7.1486 -0.3218 0.8197 H 0 0 0 0 0 0 0 0 0 0 0 0 7.1480 -0.3208 -0.9695 H 0 0 0 0 0 0 0 0 0 0 0 0 2.8650 -5.0232 -0.0583 H 0 0 0 0 0 0 0 0 0 0 0 0 4.4023 -5.1592 0.8284 H 0 0 0 0 0 0 0 0 0 0 0 0 4.4002 -5.1693 -0.9478 H 0 0 0 0 0 0 0 0 0 0 0 0 M END ``` ## Extensions No extension implemented to the original format. ## Missing Features The following features are currently not supported: - Not all modifiers are supported for the connection table - SDF key-value pair annotations are dropped - continuation lines in V3000 format are not supported @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-ein.md000066400000000000000000000067511466406626700163700ustar00rootroot00000000000000--- title: Gaussian external format --- ## Specification @Note [Reference](https://gaussian.com/external/) The first line of the input is read as four integers of width 10, ``(4i10)``, containing the number of atoms in the first integer. A run mode specific integer is given in the second entry. The third integer contains the total charge and the fourth integer the spin as number of unpaired electrons. The total charge and the systems spin are stored in the [[structure_type]]. The structure is specified by atomic numbers, cartesian coordinates in atomic units (Bohr) and a scalar quantity, usually partial charges using the fixed format ``(i10,4f20.12)``. The element is identified by its atomic number, which is converted to its capitalized element symbol internally. Only positive, non-zero integers are allowed as atomic numbers. The expected file extension is ``ein``. ## Examples Caffeine molecule in Gaussian external format: ```text 24 1 0 0 6 2.027996941030 0.092313100971 -0.143108928077 0.000000000000 7 4.750109032883 0.023734954927 -0.143241208877 0.000000000000 6 6.334341685252 2.070988200950 -0.142353037792 0.000000000000 7 8.728605263543 1.380028892063 -0.142655393906 0.000000000000 6 8.653186310426 -1.193248402810 -0.142315243278 0.000000000000 6 6.238570386230 -2.083535979669 -0.142182962479 0.000000000000 6 5.632667631585 -4.699502178348 -0.139405065684 0.000000000000 8 3.449316339873 -5.480922657010 -0.143184517105 0.000000000000 7 7.775087464402 -6.244277357876 -0.131071375299 0.000000000000 6 10.302293246446 -5.397396780594 -0.136721655174 0.000000000000 8 12.074100072866 -6.915734697428 -0.136664963403 0.000000000000 7 10.700382864677 -2.790784724183 -0.141483763966 0.000000000000 6 13.245975677887 -1.769690333624 -0.142182962479 0.000000000000 6 7.408915313425 -8.959057313972 -0.116369309269 0.000000000000 1 1.387020877193 2.055757011721 -0.141786120079 0.000000000000 1 1.346221699097 -0.863566855309 1.555905663964 0.000000000000 1 1.346240596354 -0.861336978970 -1.843408533601 0.000000000000 1 5.655967949599 4.001720959646 -0.141313688652 0.000000000000 1 14.674305959118 -3.262309083535 -0.143449078705 0.000000000000 1 13.508968805056 -0.608151528241 1.548989267863 0.000000000000 1 13.507797175115 -0.606148418987 -1.832145768365 0.000000000000 1 5.414083058620 -9.492394601323 -0.110227700709 0.000000000000 1 8.319196188304 -9.749472887017 1.565392087032 0.000000000000 1 8.315114380769 -9.768540219438 -1.791082028670 0.000000000000 ``` ## Extensions No extension implemented to the original format. ## Missing Features The following features are currently not supported: - the requested run-mode is dropped while reading. - scalar atomic quantities are not preserved and dropped. @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-gen.md000066400000000000000000000124221466406626700163560ustar00rootroot00000000000000--- title: DFTB+ general format --- ## Specification @Note [Reference](https://dftbplus.org/fileadmin/DFTBPLUS/public/dftbplus/latest/manual.pdf) The general (gen) format is used for DFTB+ as geometry input format. It is based on the [xyz format](./format-xyz.html). The first line contains the number of atoms and the specific kind of provided geometry. Available types are cluster (``C``), supercell (``S``), fractional (``F``), and helical (``H``), the letter defining the format is case-insensitive. The second line gives the element symbols for each group of atoms separated by spaces, the groups are indexed starting from 1 and references in the specification of the atomic coordinates by this index rather than their element symbol. The following lines are specified as two integers and three reals separated by spaces. The first integer is currently ignored. The second integer references the element symbol in the second line. The atomic coordinates are given in Ångström for cluster, supercell and helical, while they are given as fraction of the lattice vector for fractional input types. For supercell and fractional input the next lines contains three reals containing the origin of the structure, followed by three lines of each three reals for the lattice vectors. Lines starting with the ``#`` are comments and are ignored while parsing. The format is identified by the extension ``gen``. ## Example Caffeine molecule in genFormat: ```text 24 C C N O H 1 1 1.07317000000000E+00 4.88500000000000E-02 -7.57300000000000E-02 2 2 2.51365000000000E+00 1.25600000000000E-02 -7.58000000000000E-02 3 1 3.35199000000000E+00 1.09592000000000E+00 -7.53300000000000E-02 4 2 4.61898000000000E+00 7.30280000000000E-01 -7.54900000000000E-02 5 1 4.57907000000000E+00 -6.31440000000000E-01 -7.53100000000000E-02 6 1 3.30131000000000E+00 -1.10256000000000E+00 -7.52400000000000E-02 7 1 2.98068000000000E+00 -2.48687000000000E+00 -7.37700000000000E-02 8 3 1.82530000000000E+00 -2.90038000000000E+00 -7.57700000000000E-02 9 2 4.11440000000000E+00 -3.30433000000000E+00 -6.93600000000000E-02 10 1 5.45174000000000E+00 -2.85618000000000E+00 -7.23500000000000E-02 11 3 6.38934000000000E+00 -3.65965000000000E+00 -7.23200000000000E-02 12 2 5.66240000000000E+00 -1.47682000000000E+00 -7.48700000000000E-02 13 1 7.00947000000000E+00 -9.36480000000000E-01 -7.52400000000000E-02 14 1 3.92063000000000E+00 -4.74093000000000E+00 -6.15800000000000E-02 15 4 7.33980000000000E-01 1.08786000000000E+00 -7.50300000000000E-02 16 4 7.12390000000000E-01 -4.56980000000000E-01 8.23350000000000E-01 17 4 7.12400000000000E-01 -4.55800000000000E-01 -9.75490000000000E-01 18 4 2.99301000000000E+00 2.11762000000000E+00 -7.47800000000000E-02 19 4 7.76531000000000E+00 -1.72634000000000E+00 -7.59100000000000E-02 20 4 7.14864000000000E+00 -3.21820000000000E-01 8.19690000000000E-01 21 4 7.14802000000000E+00 -3.20760000000000E-01 -9.69530000000000E-01 22 4 2.86501000000000E+00 -5.02316000000000E+00 -5.83300000000000E-02 23 4 4.40233000000000E+00 -5.15920000000000E+00 8.28370000000000E-01 24 4 4.40017000000000E+00 -5.16929000000000E+00 -9.47800000000000E-01 ``` Ammonia molecular crystal: ```text 16 S H N 1 1 2.19855889440000E+00 1.76390058240000E+00 8.80145481600000E-01 2 1 1.76390058240000E+00 8.80145481600000E-01 2.19855889440000E+00 3 1 8.80145481600000E-01 2.19855889440000E+00 1.76390058240000E+00 4 1 4.84115108400000E+00 1.61941554720000E+00 4.93981400880000E+00 5 1 4.35630903840000E+00 2.49981169680000E+00 3.63248012160000E+00 6 1 3.51957925440000E+00 1.15357413600000E+00 4.08403345680000E+00 7 1 4.08403345680000E+00 3.51957925440000E+00 1.15357413600000E+00 8 1 4.93981400880000E+00 4.84115108400000E+00 1.61941554720000E+00 9 1 3.63248012160000E+00 4.35630903840000E+00 2.49981169680000E+00 10 1 2.49981169680000E+00 3.63248012160000E+00 4.35630903840000E+00 11 1 1.15357413600000E+00 4.08403345680000E+00 3.51957925440000E+00 12 1 1.61941554720000E+00 4.93981400880000E+00 4.84115108400000E+00 13 2 1.37461317840000E+00 1.37461317840000E+00 1.37461317840000E+00 14 2 3.99815460000000E+00 1.99105592400000E+00 4.46364507600000E+00 15 2 4.46364507600000E+00 3.99815460000000E+00 1.99105592400000E+00 16 2 1.99105592400000E+00 4.46364507600000E+00 3.99815460000000E+00 0.00000000000000 0.00000000000000 0.00000000000000 5.01336000000000 0.00000000000000 0.00000000000000 0.00000000000000 5.01336000000000 0.00000000000000 0.00000000000000 0.00000000000000 5.01336000000000 ``` ## Extensions No extension implemented to the original format. ## Missing Features The implementation of this format is (to our knowledge) feature-complete. @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-pdb.md000066400000000000000000000256611466406626700163630ustar00rootroot00000000000000--- title: Protein data bank (PDB) format --- ## Specification @Note [Reference](http://www.wwpdb.org/documentation/file-format-content/format33/v3.3.html) The extension identifying this format is ``pdb``. ## Example 4QXX protein with explicit hydrogen: ```text HEADER PROTEIN FIBRIL 22-JUL-14 4QXX TITLE STRUCTURE OF THE AMYLOID FORMING PEPTIDE GNLVS (RESIDUES 26-30) FROM TITLE 2 THE EOSINOPHIL MAJOR BASIC PROTEIN (EMBP) DBREF 4QXX Z 1 5 UNP P13727 PRG2_HUMAN 131 135 SEQRES 1 Z 5 GLY ASN LEU VAL SER FORMUL 2 HOH *2(H2 O) CRYST1 4.755 16.816 35.759 90.00 90.00 90.00 P 2 21 21 4 ORIGX1 1.000000 0.000000 0.000000 0.00000 ORIGX2 0.000000 1.000000 0.000000 0.00000 ORIGX3 0.000000 0.000000 1.000000 0.00000 SCALE1 0.210305 0.000000 0.000000 0.00000 SCALE2 0.000000 0.059467 0.000000 0.00000 SCALE3 0.000000 0.000000 0.027965 0.00000 ATOM 1 N GLY Z 1 -0.821 -2.072 16.609 1.00 9.93 N ANISOU 1 N GLY Z 1 1184 1952 638 314 -191 -326 N ATOM 2 CA GLY Z 1 -1.705 -2.345 15.487 1.00 7.38 C ANISOU 2 CA GLY Z 1 957 1374 472 279 -124 -261 C ATOM 3 C GLY Z 1 -0.968 -3.008 14.344 1.00 4.89 C ANISOU 3 C GLY Z 1 899 614 343 211 112 -106 C ATOM 4 O GLY Z 1 0.258 -2.982 14.292 1.00 5.05 O ANISOU 4 O GLY Z 1 839 595 485 -11 -7 -180 O ATOM 5 HA2 GLY Z 1 -2.130 -1.405 15.135 1.00 0.00 H ATOM 6 HA3 GLY Z 1 -2.511 -2.999 15.819 1.00 0.00 H ATOM 7 H1 GLY Z 1 -1.364 -1.742 17.394 1.00 0.00 H ATOM 8 H2 GLY Z 1 -0.150 -1.365 16.344 1.00 0.00 H ATOM 9 H3 GLY Z 1 -0.334 -2.918 16.868 1.00 0.00 H ATOM 10 N ASN Z 2 -1.721 -3.603 13.425 1.00 3.53 N ANISOU 10 N ASN Z 2 747 329 264 -226 117 -67 N ATOM 11 CA ASN Z 2 -1.141 -4.323 12.291 1.00 1.85 C ANISOU 11 CA ASN Z 2 313 164 225 76 -23 77 C ATOM 12 C ASN Z 2 -1.748 -3.900 10.968 1.00 3.00 C ANISOU 12 C ASN Z 2 610 293 238 197 -2 -42 C ATOM 13 O ASN Z 2 -2.955 -3.683 10.873 1.00 3.99 O ANISOU 13 O ASN Z 2 599 514 402 199 191 -60 O ATOM 14 CB ASN Z 2 -1.353 -5.827 12.446 1.00 5.03 C ANISOU 14 CB ASN Z 2 1173 368 369 170 -47 37 C ATOM 15 CG ASN Z 2 -0.679 -6.391 13.683 1.00 5.08 C ANISOU 15 CG ASN Z 2 727 718 484 228 -243 90 C ATOM 16 OD1 ASN Z 2 0.519 -6.202 13.896 1.00 6.10 O ANISOU 16 OD1 ASN Z 2 828 960 531 477 -61 100 O ATOM 17 ND2 ASN Z 2 -1.448 -7.087 14.506 1.00 8.41 N ANISOU 17 ND2 ASN Z 2 1513 1193 488 40 102 279 N ATOM 18 H ASN Z 2 -2.726 -3.557 13.512 1.00 0.00 H ATOM 19 HA ASN Z 2 -0.070 -4.123 12.263 1.00 0.00 H ATOM 20 HB2 ASN Z 2 -0.945 -6.328 11.568 1.00 0.00 H ATOM 21 HB3 ASN Z 2 -2.423 -6.029 12.503 1.00 0.00 H ATOM 22 HD21 ASN Z 2 -2.427 -7.218 14.293 1.00 0.00 H ATOM 23 HD22 ASN Z 2 -1.056 -7.487 15.346 1.00 0.00 H ATOM 24 N LEU Z 3 -0.907 -3.803 9.944 1.00 3.47 N ANISOU 24 N LEU Z 3 701 405 213 -242 25 -26 N ATOM 25 CA LEU Z 3 -1.388 -3.576 8.586 1.00 3.48 C ANISOU 25 CA LEU Z 3 728 324 271 79 180 -5 C ATOM 26 C LEU Z 3 -0.783 -4.660 7.709 1.00 3.29 C ANISOU 26 C LEU Z 3 684 261 306 -17 150 -80 C ATOM 27 O LEU Z 3 0.437 -4.788 7.643 1.00 3.80 O ANISOU 27 O LEU Z 3 590 437 415 141 178 -122 O ATOM 28 CB LEU Z 3 -0.977 -2.185 8.081 1.00 3.88 C ANISOU 28 CB LEU Z 3 899 293 282 171 125 42 C ATOM 29 CG LEU Z 3 -1.524 -1.669 6.736 1.00 8.66 C ANISOU 29 CG LEU Z 3 2091 598 600 63 -94 66 C ATOM 30 CD1 LEU Z 3 -1.225 -0.191 6.570 1.00 9.89 C ANISOU 30 CD1 LEU Z 3 2263 792 703 132 -163 143 C ATOM 31 CD2 LEU Z 3 -0.962 -2.409 5.541 1.00 13.56 C ANISOU 31 CD2 LEU Z 3 3203 1048 901 -640 -305 94 C ATOM 32 H LEU Z 3 0.086 -3.888 10.109 1.00 0.00 H ATOM 33 HA LEU Z 3 -2.475 -3.661 8.568 1.00 0.00 H ATOM 34 HB2 LEU Z 3 -1.284 -1.469 8.843 1.00 0.00 H ATOM 35 HB3 LEU Z 3 0.111 -2.162 8.026 1.00 0.00 H ATOM 36 HG LEU Z 3 -2.606 -1.798 6.737 1.00 0.00 H ATOM 37 HD11 LEU Z 3 -1.623 0.359 7.423 1.00 0.00 H ATOM 38 HD12 LEU Z 3 -1.691 0.173 5.654 1.00 0.00 H ATOM 39 HD13 LEU Z 3 -0.147 -0.043 6.513 1.00 0.00 H ATOM 40 HD21 LEU Z 3 -1.168 -3.475 5.643 1.00 0.00 H ATOM 41 HD22 LEU Z 3 -1.429 -2.035 4.630 1.00 0.00 H ATOM 42 HD23 LEU Z 3 0.115 -2.250 5.489 1.00 0.00 H ATOM 43 N VAL Z 4 -1.635 -5.424 7.029 1.00 3.17 N ANISOU 43 N VAL Z 4 604 266 333 -100 104 -123 N ATOM 44 CA VAL Z 4 -1.165 -6.460 6.119 1.00 3.61 C ANISOU 44 CA VAL Z 4 607 353 411 205 -241 -157 C ATOM 45 C VAL Z 4 -1.791 -6.230 4.755 1.00 5.31 C ANISOU 45 C VAL Z 4 543 915 562 395 -15 -39 C ATOM 46 O VAL Z 4 -3.014 -6.209 4.620 1.00 7.31 O ANISOU 46 O VAL Z 4 577 1569 630 45 -5 -227 O ATOM 47 CB VAL Z 4 -1.567 -7.872 6.593 1.00 5.31 C ANISOU 47 CB VAL Z 4 1024 336 657 64 39 -167 C ATOM 48 CG1 VAL Z 4 -1.012 -8.934 5.633 1.00 6.73 C ANISOU 48 CG1 VAL Z 4 1131 549 879 220 104 -300 C ATOM 49 CG2 VAL Z 4 -1.083 -8.120 8.018 1.00 5.48 C ANISOU 49 CG2 VAL Z 4 819 632 630 15 15 42 C ATOM 50 H VAL Z 4 -2.628 -5.282 7.146 1.00 0.00 H ATOM 51 HA VAL Z 4 -0.080 -6.402 6.034 1.00 0.00 H ATOM 52 HB VAL Z 4 -2.655 -7.939 6.585 1.00 0.00 H ATOM 53 HG11 VAL Z 4 -1.303 -9.926 5.980 1.00 0.00 H ATOM 54 HG12 VAL Z 4 -1.414 -8.766 4.634 1.00 0.00 H ATOM 55 HG13 VAL Z 4 0.075 -8.864 5.603 1.00 0.00 H ATOM 56 HG21 VAL Z 4 -1.377 -9.121 8.333 1.00 0.00 H ATOM 57 HG22 VAL Z 4 0.003 -8.032 8.053 1.00 0.00 H ATOM 58 HG23 VAL Z 4 -1.529 -7.383 8.686 1.00 0.00 H ATOM 59 N SER Z 5 -0.966 -6.052 3.736 1.00 7.53 N ANISOU 59 N SER Z 5 810 1357 693 337 48 302 N ATOM 60 CA SER Z 5 -1.526 -5.888 2.407 1.00 11.48 C ANISOU 60 CA SER Z 5 1654 1766 943 560 -145 241 C ATOM 61 C SER Z 5 -1.207 -7.085 1.529 1.00 16.35 C ANISOU 61 C SER Z 5 3066 2118 1029 758 -523 -208 C ATOM 62 O SER Z 5 -0.437 -7.976 1.902 1.00 14.00 O ANISOU 62 O SER Z 5 2584 1676 1060 878 -402 -452 O ATOM 63 CB SER Z 5 -1.031 -4.596 1.767 1.00 13.36 C ANISOU 63 CB SER Z 5 1565 2151 1361 818 -30 608 C ATOM 64 OG SER Z 5 0.361 -4.652 1.540 1.00 15.80 O ANISOU 64 OG SER Z 5 1604 2812 1587 822 25 763 O ATOM 65 OXT SER Z 5 -1.737 -7.178 0.429 1.00 17.09 O ANISOU 65 OXT SER Z 5 2807 2495 1192 648 -712 -430 O ATOM 66 H SER Z 5 0.033 -6.031 3.880 1.00 0.00 H ATOM 67 HA SER Z 5 -2.610 -5.822 2.504 1.00 0.00 H ATOM 68 HB2 SER Z 5 -1.543 -4.449 0.816 1.00 0.00 H ATOM 69 HB3 SER Z 5 -1.254 -3.759 2.428 1.00 0.00 H ATOM 70 HG SER Z 5 0.653 -3.831 1.137 1.00 0.00 H TER 71 SER Z 5 HETATM 72 O HOH Z 101 0.935 -5.175 16.502 1.00 18.83 O ANISOU 72 O HOH Z 101 3066 2772 1315 -1227 -232 339 O HETATM 73 H1 HOH Z 101 0.794 -5.522 15.621 1.00 0.00 H HETATM 74 H2 HOH Z 101 1.669 -4.561 16.489 1.00 0.00 H HETATM 75 O AHOH Z 102 0.691 -8.408 17.879 0.91 56.55 O ANISOU 75 O AHOH Z 102 9673 9234 2579 0 5 1219 O HETATM 76 O BHOH Z 102 -0.788 -9.006 16.641 0.09 38.95 O ANISOU 76 O BHOH Z 102 6801 4266 3734 2095 -1531 549 O HETATM 77 H1 AHOH Z 102 1.392 -8.125 18.466 0.91 0.00 H HETATM 78 H1 BHOH Z 102 -1.351 -9.776 16.563 0.09 0.00 H HETATM 79 H2 AHOH Z 102 0.993 -8.356 16.972 0.91 0.00 H HETATM 80 H2 BHOH Z 102 -0.927 -8.594 17.494 0.09 0.00 H CONECT 73 72 CONECT 74 72 CONECT 72 73 74 CONECT 78 76 CONECT 77 75 CONECT 80 76 CONECT 79 75 CONECT 75 77 79 CONECT 76 78 80 END ``` ## Extensions No extension implemented to the original format. ## Missing Features The following features are currently not supported: - Support for multiple file PDB input is not available - Fractional side occupation is currently not supported all optional sides count as full atoms - Cell information is not preserved, PDB input is always handled molecular @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-qchem.md000066400000000000000000000046661466406626700167150ustar00rootroot00000000000000--- title: Q-Chem molecule format --- ## Specification @Note: Reference can be found in the [Q-Chem manual](https://manual.q-chem.com/5.1/sect-molinput.html). Format used by the Q-Chem program. Elements can be specified either by atomic numbers or element symbols while the geometry is provided in Ångström by default. ## Example Caffeine molecule in xyz format ``` $molecule 0 1 C 1.07320000000000 0.04890000000000 -0.07570000000000 N 2.51370000000000 0.01260000000000 -0.07580000000000 C 3.35200000000000 1.09590000000000 -0.07530000000000 N 4.61900000000000 0.73030000000000 -0.07550000000000 C 4.57910000000000 -0.63140000000000 -0.07530000000000 C 3.30130000000000 -1.10260000000000 -0.07520000000000 C 2.98070000000000 -2.48690000000000 -0.07380000000000 O 1.82530000000000 -2.90040000000000 -0.07580000000000 N 4.11440000000000 -3.30430000000000 -0.06940000000000 C 5.45170000000000 -2.85620000000000 -0.07240000000000 O 6.38930000000000 -3.65970000000000 -0.07230000000000 N 5.66240000000000 -1.47680000000000 -0.07490000000000 C 7.00950000000000 -0.93650000000000 -0.07520000000000 C 3.92060000000000 -4.74090000000000 -0.06160000000000 H 0.73400000000000 1.08790000000000 -0.07500000000000 H 0.71240000000000 -0.45700000000000 0.82340000000000 H 0.71240000000000 -0.45580000000000 -0.97550000000000 H 2.99300000000000 2.11760000000000 -0.07480000000000 H 7.76530000000000 -1.72630000000000 -0.07590000000000 H 7.14860000000000 -0.32180000000000 0.81970000000000 H 7.14800000000000 -0.32080000000000 -0.96950000000000 H 2.86500000000000 -5.02320000000000 -0.05830000000000 H 4.40230000000000 -5.15920000000000 0.82840000000000 H 4.40020000000000 -5.16930000000000 -0.94780000000000 $end ``` ## Missing Features Following features are missing - reading of z-matrix input - possibility to change coordinate units to Bohr @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-qcschema.md000066400000000000000000000064601466406626700173760ustar00rootroot00000000000000--- title: QCSchema JSON --- ## Specification @Note [Reference](https://molssi-qc-schema.readthedocs.io) JSON files are identified by the extension ``json`` and parsed following the ``qcschema_molecule`` or ``qcschema_input`` format. The ``molecule`` entry from a ``qcschema_input`` will be extracted, but there is no guarantee that the input information will be used by the program. ## Example Caffeine molecule in ``qcschema_molecule`` format. ```json { "schema_version": 2, "schema_name": "qcschema_molecule", "provenance": { "creator": "mctc-lib", "version": "0.2.3", "routine": "mctc_io_write_qcschema::write_qcschema" }, "symbols": [ "C", "N", "C", "N", "C", "C", "C", "O", "N", "C", "O", "N", "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H" ], "geometry": [ 2.0280536328008760E+00, 9.2407587256767454E-02,-1.4305223630546618E-01, 4.7502035191684326E+00, 2.3810543955731494E-02,-1.4324120887654343E-01, 6.3343605825088858E+00, 2.0709504064354083E+00,-1.4229634602115726E-01, 8.7286430580574415E+00, 1.3800666865770403E+00,-1.4267429116331171E-01, 8.6532430021976250E+00,-1.1931728137816557E+00,-1.4229634602115726E-01, 6.2385514889727283E+00,-2.0836115686975827E+00,-1.4210737345008001E-01, 5.6327054260991156E+00,-4.6995588701197342E+00,-1.3946175745499875E-01, 3.4493163398727531E+00,-5.4809604515240968E+00,-1.4324120887654343E-01, 7.7750874644017181E+00,-6.2442206661050452E+00,-1.3114696432760045E-01, 1.0302217657417570E+01,-5.3974345751079591E+00,-1.3681614145991747E-01, 1.2074024483837716E+01,-6.9158291837135346E+00,-1.3662716888884024E-01, 1.0700382864677302E+01,-2.7907469296685923E+00,-1.4154045573684831E-01, 1.3246032369658721E+01,-1.7697281281382971E+00,-1.4210737345008001E-01, 7.4088586216540389E+00,-8.9590006222005893E+00,-1.1640710378357619E-01, 1.3870586717068980E+00, 2.0558326007492296E+00,-1.4172942830792554E-01, 1.3462405963542154E+00,-8.6360464982295970E-01, 1.5560001502499454E+00, 1.3462405963542154E+00,-8.6133697897003281E-01,-1.8434274308584184E+00, 5.6559490523416152E+00, 4.0016831651315083E+00,-1.4135148316577109E-01, 1.4674287061860456E+01,-3.2622334945062916E+00,-1.4343018144762065E-01, 1.3508893216027154E+01,-6.0811373372653921E-01, 1.5490081651200875E+00, 1.3507759380600691E+01,-6.0622400801576681E-01,-1.8320890765937843E+00, 5.4140641613627567E+00,-9.4924701903516215E+00,-1.1017100893802745E-01, 8.3191394965330758E+00,-9.7494728870166600E+00, 1.5654487788038070E+00, 8.3151710725404531E+00,-9.7685591166954602E+00,-1.7910820286700244E+00 ], "molecular_charge": 0, "connectivity": [ [ 0, 1, 1], [ 1, 2, 4], [ 2, 3, 4], [ 3, 4, 4], [ 1, 5, 1], [ 4, 5, 4], [ 5, 6, 1], [ 6, 7, 2], [ 6, 8, 1], [ 8, 9, 1], [ 9,10, 2], [ 4,11, 1], [ 9,11, 1], [11,12, 1], [ 8,13, 1], [ 0,14, 1], [ 0,15, 1], [ 0,16, 1], [ 2,17, 1], [12,18, 1], [12,19, 1], [12,20, 1], [13,21, 1], [13,22, 1], [13,23, 1] ] } ``` ## Missing features The schema is not verified on completeness and not all data is stored in the final structure type. @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-tmol.md000066400000000000000000000152471466406626700165700ustar00rootroot00000000000000--- title: Turbomole's coordinate data group --- ## Specification @Note [Reference](https://www.turbomole.org/wp-content/uploads/2019/11/Turbomole_Manual_7-4-1.pdf) The Turbomole format mainly builds around the ``control`` file. The ``control`` file contains several data groups which are delimited by their identifier, groups are either present in the ``control`` file or references from the ``control`` file. This format is defined by the geometry related information from the ``control`` file, mainly the: - ``coord`` data group - ``lattice`` data group - ``cell`` data group - ``periodic`` data group - ``eht`` data group For simplicity file references are not allowed and all data groups should be in the same file. The data groups are not required to be in any particular order. A group is started by a ``$`` symbol and accept modifiers. It is terminated by another group or the ``end`` group which stops the scanning for further groups: ```text $group1 [modifier]... [entries]... $group2 [modifier]... [entries]... $end ``` The ``coord`` data group contains the cartesian coordinates of all atoms and their element symbols at the end of each line. Atomic coordinates can either be specified in Bohr, by default or with the ``bohr`` modifier on the ``coord`` data group, in Ångström with the modifier ``angs`` or as fractions of the lattice vectors with the modifier ``frac``. Fractional coordinates can only be present for periodicities greater than zero. The periodicity of the system is specified as modifier to the ``periodic`` data group, the group itself is empty. The lattice parameters can either be specified in the ``lattice`` or the ``cell`` data group, which require different amounts of entries depending on the systems periodicity. Both data groups are either given in atomic units (Bohr) or in Ångström with the ``angs`` modifier. For 3D periodic systems three lines with each three reals are required in the ``lattice`` data group. For a 2D periodic system two lines with each two reals are required and the aperiodic direction is the z-axis. Finally, for 1D periodic systems one real is required, giving the translation vector in the x-direction. The periodic directions are fixed in this format. Similarly, the ``cell`` data groups allows for six, three, and one entries for 3D, 2D, and 1D periodic systems, respectively. The cell parameters are given as the length of the lattice vectors and their angles, with the angles given in degrees. Charge and spin can be given in the ``eht`` data group with ```text $eht charge= unpaired= ``` The format is identified by ``coord`` or ``tmol`` extension or by using ``coord`` as basename. ## Example Caffeine molecule in Turbomole's coord format ```text $coord 2.02799694102955E+00 9.23131009712288E-02 -1.43108928076789E-01 C 4.75010903288289E+00 2.37349549273006E-02 -1.43241208876543E-01 N 6.33434168525178E+00 2.07098820094962E+00 -1.42353037792480E-01 C 8.72860526354322E+00 1.38002889206282E+00 -1.42655393906204E-01 N 8.65318631042630E+00 -1.19324840281009E+00 -1.42315243278265E-01 C 6.23857038622984E+00 -2.08353597966915E+00 -1.42182962478511E-01 C 5.63266763158490E+00 -4.69950217834841E+00 -1.39405065683676E-01 C 3.44931633987275E+00 -5.48092265700988E+00 -1.43184517105220E-01 O 7.77508746440172E+00 -6.24427735787637E+00 -1.31071375299170E-01 N 1.03022932464460E+01 -5.39739678059374E+00 -1.36721655174379E-01 C 1.20741000728661E+01 -6.91573469742800E+00 -1.36664963403056E-01 O 1.07003828646773E+01 -2.79078472418281E+00 -1.41483763965525E-01 N 1.32459756778874E+01 -1.76969033362408E+00 -1.42182962478511E-01 C 7.40891531342536E+00 -8.95905731397191E+00 -1.16369309269361E-01 C 1.38702087719268E+00 2.05575701172080E+00 -1.41786120079249E-01 H 1.34622169909711E+00 -8.63566855308744E-01 1.55590566396441E+00 H 1.34624059635422E+00 -8.61336978970033E-01 -1.84340853360131E+00 H 5.65596794959872E+00 4.00172095964572E+00 -1.41313688651556E-01 H 1.46743059591176E+01 -3.26230908353472E+00 -1.43449078704728E-01 H 1.35089688050556E+01 -6.08151528240755E-01 1.54898926786298E+00 H 1.35077971751149E+01 -6.06148418987336E-01 -1.83214576836511E+00 H 5.41408305861986E+00 -9.49239460132319E+00 -1.10227700709351E-01 H 8.31919618830440E+00 -9.74947288701666E+00 1.56539208703248E+00 H 8.31511438076913E+00 -9.76854021943835E+00 -1.79108202867002E+00 H $end ``` Ammonia molecular crystal: ```text $coord 4.15467326939489E+00 3.33328828180759E+00 1.66323354579962E+00 H 3.33328828180759E+00 1.66323354579962E+00 4.15467326939489E+00 H 1.66323354579962E+00 4.15467326939489E+00 3.33328828180759E+00 H 9.14844767316819E+00 3.06025119596830E+00 9.33489353886275E+00 H 8.23222919393441E+00 4.72395843553239E+00 6.86439107965696E+00 H 6.65103940814062E+00 2.17993870408119E+00 7.71770302696940E+00 H 7.71770302696940E+00 6.65103940814062E+00 2.17993870408119E+00 H 9.33489353886275E+00 9.14844767316819E+00 3.06025119596830E+00 H 6.86439107965696E+00 8.23222919393441E+00 4.72395843553239E+00 H 4.72395843553239E+00 6.86439107965696E+00 8.23222919393441E+00 H 2.17993870408119E+00 7.71770302696940E+00 6.65103940814062E+00 H 3.06025119596830E+00 9.33489353886275E+00 9.14844767316819E+00 H 2.59764186558897E+00 2.59764186558897E+00 2.59764186558897E+00 N 7.55541554326270E+00 3.76254957116838E+00 8.43506486387956E+00 N 8.43506486387956E+00 7.55541554326270E+00 3.76254957116838E+00 N 3.76254957116838E+00 8.43506486387956E+00 7.55541554326270E+00 N $periodic 3 $lattice 9.47387528935762 0.00000000000000 0.00000000000000 0.00000000000000 9.47387528935762 0.00000000000000 0.00000000000000 0.00000000000000 9.47387528935762 $end ``` ## Extensions The original format does only allow for the ``periodic`` or ``eht`` group to appear in the ``control`` file, to make the format self-contained, all groups must appear in the same file. The ``coord`` group only supports the ``frac`` modifier in Turbomole, but this reader also allows ``angs`` and ``bohr``. ## Missing Features The following features are currently not supported: - Preserving information about frozen atoms from ``coord`` data group @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-vasp.md000066400000000000000000000054121466406626700165570ustar00rootroot00000000000000--- title: Vasp's POSCAR format --- @Note [Reference](https://www.vasp.at/wiki/index.php/POSCAR) The format is identified by the extension ``vasp``, ``poscar`` or ``contcar``. Alternatively, the basenames ``poscar`` and ``contcar`` identify the format as well. ## Examples Ammonia molecular crystal in pre Vasp 5 POSCAR format: ```text H N 1.0000000000000000 5.0133599999999996 0.0000000000000000 0.0000000000000000 0.0000000000000000 5.0133599999999996 0.0000000000000000 0.0000000000000000 0.0000000000000000 5.0133599999999996 12 4 Cartesian 2.1985588943999996 1.7639005823999998 0.8801454815999999 1.7639005823999998 0.8801454815999999 2.1985588943999996 0.8801454815999999 2.1985588943999996 1.7639005823999998 4.8411510839999998 1.6194155471999998 4.9398140088000000 4.3563090384000001 2.4998116967999997 3.6324801215999996 3.5195792543999995 1.1535741359999998 4.0840334567999994 4.0840334567999994 3.5195792543999995 1.1535741359999998 4.9398140088000000 4.8411510839999998 1.6194155471999998 3.6324801215999996 4.3563090384000001 2.4998116967999997 2.4998116967999997 3.6324801215999996 4.3563090384000001 1.1535741359999998 4.0840334567999994 3.5195792543999995 1.6194155471999998 4.9398140088000000 4.8411510839999998 1.3746131783999997 1.3746131783999997 1.3746131783999997 3.9981545999999994 1.9910559239999999 4.4636450759999997 4.4636450759999997 3.9981545999999994 1.9910559239999999 1.9910559239999999 4.4636450759999997 3.9981545999999994 ``` Carbondioxide in POSCAR format: ```text 4CO2 1.00000000000000 5.68032000000000 0.00000000000000 0.00000000000000 0.00000000000000 5.68032000000000 0.00000000000000 0.00000000000000 0.00000000000000 5.68032000000000 C O 4 8 Cartesian 0.94412598720000 0.94378516800000 0.95435056320000 3.71799665280000 0.95565703680000 3.73168622400000 3.71595173760000 3.71492928000000 0.96923300160000 0.95298728640000 3.72208648320000 3.72969811200000 1.62139054080000 1.61906160960000 1.63138790400000 0.26566856640000 0.26941757760000 0.27765404160000 4.39145539200000 1.63462568640000 3.05459208000000 3.04408348800000 0.27646117440000 4.40804192640000 4.39105776960000 3.04164095040000 0.28810583040000 3.03999365760000 4.38793359360000 1.64973533760000 0.27413224320000 4.40037349440000 3.05737543680000 1.63121749440000 3.04345865280000 4.40230480320000 ``` ## Extensions No extension implemented to the original format. ## Missing Features The implementation of this format is (to our knowledge) feature-complete. @Note Feel free to bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/format-xyz.md000066400000000000000000000062371466406626700164460ustar00rootroot00000000000000--- title: xyz format --- ## Specification @Note [Reference](http://www.ccl.net/chemistry/resources/messages/1996/10/21.005-dir/index.html) Simple format to store cartesian coordinates and element symbols. The first line contains the number of atoms in the geometry. The second line is a comment line and ignored, some program store additional information here. The following lines contain a short character identifier and three reals. The first entry is interpreted as element symbol and defines the atomic species. The atomic coordinates are given in Ångström. A scalar quantity can be added to each atom with one real as well as a vector quantity by three reals, allowing additional four reals per atomic entry. The format is identified by the file extension ``xyz`` or ``log``. ## Examples Caffeine molecule in xyz format ```text 24 C 1.07317000000000 0.04885000000000 -0.07573000000000 N 2.51365000000000 0.01256000000000 -0.07580000000000 C 3.35199000000000 1.09592000000000 -0.07533000000000 N 4.61898000000000 0.73028000000000 -0.07549000000000 C 4.57907000000000 -0.63144000000000 -0.07531000000000 C 3.30131000000000 -1.10256000000000 -0.07524000000000 C 2.98068000000000 -2.48687000000000 -0.07377000000000 O 1.82530000000000 -2.90038000000000 -0.07577000000000 N 4.11440000000000 -3.30433000000000 -0.06936000000000 C 5.45174000000000 -2.85618000000000 -0.07235000000000 O 6.38934000000000 -3.65965000000000 -0.07232000000000 N 5.66240000000000 -1.47682000000000 -0.07487000000000 C 7.00947000000000 -0.93648000000000 -0.07524000000000 C 3.92063000000000 -4.74093000000000 -0.06158000000000 H 0.73398000000000 1.08786000000000 -0.07503000000000 H 0.71239000000000 -0.45698000000000 0.82335000000000 H 0.71240000000000 -0.45580000000000 -0.97549000000000 H 2.99301000000000 2.11762000000000 -0.07478000000000 H 7.76531000000000 -1.72634000000000 -0.07591000000000 H 7.14864000000000 -0.32182000000000 0.81969000000000 H 7.14802000000000 -0.32076000000000 -0.96953000000000 H 2.86501000000000 -5.02316000000000 -0.05833000000000 H 4.40233000000000 -5.15920000000000 0.82837000000000 H 4.40017000000000 -5.16929000000000 -0.94780000000000 ``` ## Extensions The reader supports the following extensions: - Atomic numbers are allowed instead of element symbols. They are automatically converted to capitalized element symbols ## Missing Features The following features are currently not supported: - Scalar atomic quantities are not preserved and dropped. - Vector atomic quantities are not preserved and dropped. @Note Feel free to contribute support for missing features or bring missing features to our attention by opening an issue. mctc-lib-0.3.2/doc/index.md000066400000000000000000000011661466406626700154310ustar00rootroot00000000000000--- title: Formats --- This library supports reading and writing of the following formats: - [xyz with extensions](./format-xyz.html) - [Turbomole's coord](./format-tmol.html) - [connection table files: molfile, structure data format](./format-ctfile.html) - [Vasp's POSCAR format](./format-vasp.html) - [a subset of PDB format](./format-pdb.html) - [DFTB+ general format](./format-gen.html) - [Gaussian external format](./format-ein.html) - [Chemical JSON format](./format-cjson.html) - [QCSchema JSON format](./format-qcschema.html) - [FHI-aims geometry.in](./format-aims.html) - [Q-Chem molecule format](./format-qchem.html) mctc-lib-0.3.2/docs.md000066400000000000000000000071471466406626700145120ustar00rootroot00000000000000--- project: MCTC-library summary: Modular computation tool chain library project_github: https://github.com/grimme-lab/mctc-lib project_download: https://github.com/grimme-lab/mctc-lib/releases author: Grimme group, Bonn github: https://github.com/grimme-lab src_dir: ./src ./app output_dir: ./_docs exclude_dir: ./test page_dir: ./doc docmark: < predocmark: > source: true graph: false sort: alpha print_creation_date: true extra_mods: iso_fortran_env:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fFORTRAN_005fENV.html creation_date: %Y-%m-%d %H:%M %z md_extensions: markdown.extensions.toc markdown.extensions.smarty --- Common tool chain for working with molecular structure data in various applications. This library provides a unified way to perform operations on molecular structure data, like reading and writing to common geometry file formats. [TOC] ## Input and Output The IO module ([[mctc_io]]) provides access to a common type to declare molecular structure data ([[structure_type]]). Also, reader routines ([[mctc_io_read]]) to obtain [[structure_type]] objects from input files are available. To write a [[structure_type]] object a set of writer routines are available as well ([[mctc_io_write]]). ## Standard environment The tool chain library provides an environment module ([[mctc_env]]) to allow the usage of common constants across different users. For a minimal error handling the [[error_type]] is available and should be passed as allocatable type to the library procedures. The allocation status of the [[error_type]] is used to determine failed executions and the respective error message is stored transparently in the [[error_type]]. ## Light testing framework Additionally, the environment module provides a testsuite implementation to setup a slim and light testing framework in dependent applications. The test framework can be easily setup by the [[mctc_env_testing]] module. ## Getting Started ### Meson Create a new meson project and include `mctc-lib` either as git-submodule in your subprojects directory or create a wrap file to fetch it from upstream: ```ini [wrap-git] directory = mctc-lib url = https://github.com/grimme-lab/mctc-lib revision = head ``` To load the project the necessary boilerplate code for subprojects is just ```python mctc_prj = subproject( 'mctc-lib', version: '>=0.1', default_options: [ 'default_library=static', ], ) mctc_dep = mctc_prj.get_variable('mctc_dep') ``` Now you can add `mctc_dep` to your dependencies and access the public API by the `mctc` module. We recommend to set the default library type of `mctc-lib` to static when linking your applications or library against it. Note for library type both and shared `mctc-lib` will install itself along with your project. For more fine-tuned control you can access: - the library target with `mctc_lib` - the private include dir of this target, containing the Fortran module files, with `mctc_inc` - the license files of `mctc-lib` with `mctc_lic` If you are linking your application statically against `mctc-lib` and still want to distribute the license files of `mctc-lib` (thank you), just use ```python install_data( mctc_prj.get_variable('mctc_lic'), install_dir: get_option('datadir')/'licenses'/meson.project_name()/'mctc-lib', ) ``` ### Fortran Package Manager (fpm) This project supports [fpm](https://github.com/fortran-lang/fpm) as build system as well. Just add it to the dependencies in your `fpm.toml` file: ```toml [dependencies] [dependencies.mctc-lib] git = "https://github.com/grimme-lab/mctc-lib" ``` mctc-lib-0.3.2/example/000077500000000000000000000000001466406626700146625ustar00rootroot00000000000000mctc-lib-0.3.2/example/CMakeLists.txt000066400000000000000000000020221466406626700174160ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. cmake_minimum_required(VERSION 3.14) project( "mctc-convert" LANGUAGES "Fortran" VERSION "0.2.3" DESCRIPTION "Example project for converting geometry inputs" ) if(NOT TARGET "mctc-lib::mctc-lib") find_package("mctc-lib") endif() add_executable( "${PROJECT_NAME}" "../app/main.f90" ) target_link_libraries( "${PROJECT_NAME}" PRIVATE "mctc-lib::mctc-lib" ) install( TARGETS "${PROJECT_NAME}" DESTINATION "${CMAKE_INSTALL_BINDIR}" ) mctc-lib-0.3.2/example/meson.build000066400000000000000000000014711466406626700170270ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. project( 'mctc-convert', 'fortran', ) mctc_dep = dependency('mctc-lib', fallback: ['mctc-lib', 'mctc_dep']) mctc_convert_exe = executable( 'mctc-convert', sources: files('../app/main.f90'), dependencies: mctc_dep, install: true, ) mctc-lib-0.3.2/fpm.toml000066400000000000000000000005741466406626700147140ustar00rootroot00000000000000name = "mctc-lib" version = "0.3.2" license = "Apache-2.0" maintainer = ["@awvwgk"] author = ["Sebastian Ehlert"] copyright = "2020-2024 Sebastian Ehlert" description = "Modular computation tool chain library" keywords = ["computational-chemistry", "io"] [dependencies] json-fortran.git = "https://github.com/jacobwilliams/json-fortran.git" [[executable]] name = "mctc-convert" mctc-lib-0.3.2/include/000077500000000000000000000000001466406626700146525ustar00rootroot00000000000000mctc-lib-0.3.2/include/mctc/000077500000000000000000000000001466406626700156005ustar00rootroot00000000000000mctc-lib-0.3.2/include/mctc/defs.h000066400000000000000000000001401466406626700166650ustar00rootroot00000000000000#ifndef mctc_defs_fh #define mctc_defs_fh #ifndef WITH_JSON #define WITH_JSON 1 #endif #endif mctc-lib-0.3.2/man/000077500000000000000000000000001466406626700140025ustar00rootroot00000000000000mctc-lib-0.3.2/man/mctc-convert.1.adoc000066400000000000000000000037021466406626700173770ustar00rootroot00000000000000= mctc-convert(1) :doctype: manpage == Name mctc-convert - Convert between supported input formats of the tool chain library == Synopsis *mctc-convert* [_options_] _input_ _output_ == Description Read structure from input file and writes it to output file. The format is determined by the file extension or the format hint. The input structure can be read from standard input by providing - as argument. Similarly, the output structure can be written to standard output with - as argument. Standard input and standard output should be combined with a format hint option. Supported formats: - Xmol/xyz files (xyz, log) - Turbomole's coord, riper's periodic coord (tmol, coord) - DFTB+ genFormat geometry inputs as cluster, supercell or fractional (gen) - VASP's POSCAR/CONTCAR input files (vasp, poscar, contcar) - Protein Database files, only single files (pdb) - Connection table files, molfile (mol) and structure data format (sdf) - Gaussian's external program input (ein) - JSON input with `qcschema_molecule` or `qcschema_input` structure (json) - Chemical JSON input (cjson) - FHI-AIMS' input files (geometry.in) - Q-Chem molecule block inputs (qchem) == Options *-i, --input* _format_:: Hint for the format of the input file *-o, --output* _format_:: Hint for the format of the output file *--normalize*:: Normalize all element symbols to capitalized format *--template* _file_:: File to use as template to fill in meta data (useful to add back SDF or PDB annotions). Transfers lattice, periodicity, comments and format specific annotations from the template to the input structure. If the standard input, -, is provided the template structure will be read _before_ the input structure. *--template-format* _format_:: Hint for the format of the template file (only used if template file name is provided) *--ignore-dot-files*:: Do not read charge and spin from .CHRG and .UHF files *--version*:: Print program version and exit *--help*:: Show this help message mctc-lib-0.3.2/meson.build000066400000000000000000000046051466406626700153760ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. project( 'mctc-lib', 'fortran', version: '0.3.2', license: 'Apache-2.0', meson_version: '>=0.55', default_options: [ 'buildtype=debugoptimized', 'default_library=both', ], ) install = not (meson.is_subproject() and get_option('default_library') == 'static') # General configuration information lib_deps = [] subdir('config') # Collect source of the project srcs = [] subdir('src') # MCTC library target mctc_lib = library( meson.project_name(), sources: srcs, version: meson.project_version(), include_directories: include_directories('include'), dependencies: lib_deps, fortran_args: [ '-DWITH_JSON=@0@'.format(jsonfortran_dep.found() ? '1' : '0'), ], install: install, ) # Export dependency for other projects and test suite mctc_inc = mctc_lib.private_dir_include() mctc_dep = declare_dependency( link_with: mctc_lib, include_directories: mctc_inc, dependencies: lib_deps, ) # Add applications subdir('app') # Package the license files mctc_lic = files( 'LICENSE', ) if install # Distribute the license files in share/licenses/ install_data( mctc_lic, install_dir: get_option('datadir')/'licenses'/meson.project_name() ) module_id = meson.project_name() / 'modules' meson.add_install_script( find_program(files('config'/'install-mod.py')), get_option('includedir') / module_id, ) pkg = import('pkgconfig') pkg.generate( mctc_lib, description: 'Modular computation tool chain', subdirs: ['', module_id], ) asciidoc = find_program('asciidoctor', required: false) if asciidoc.found() install_man( configure_file( command: [asciidoc, '-b', 'manpage', '@INPUT@', '-o', '@OUTPUT@'], input: files('man/mctc-convert.1.adoc'), output: '@BASENAME@', ) ) endif endif # add the testsuite subdir('test') mctc-lib-0.3.2/meson_options.txt000066400000000000000000000014461466406626700166710ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. option( 'openmp', type: 'boolean', value: false, yield: true, description: 'use OpenMP parallelisation', ) option( 'json', type: 'feature', value: 'auto', yield: true, description: 'support JSON input', ) mctc-lib-0.3.2/src/000077500000000000000000000000001466406626700140165ustar00rootroot00000000000000mctc-lib-0.3.2/src/CMakeLists.txt000066400000000000000000000011771466406626700165640ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. add_subdirectory("mctc") set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/000077500000000000000000000000001466406626700147445ustar00rootroot00000000000000mctc-lib-0.3.2/src/mctc/CMakeLists.txt000066400000000000000000000014201466406626700175010ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. add_subdirectory("env") add_subdirectory("io") set(dir "${CMAKE_CURRENT_SOURCE_DIR}") list( APPEND srcs "${dir}/env.f90" "${dir}/io.f90" "${dir}/version.F90" ) set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/env.f90000066400000000000000000000016101466406626700160520ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Public API reexport of environment library module mctc_env use mctc_env_accuracy, only : sp, dp, wp, i1, i2, i4, i8 use mctc_env_error, only : error_type, fatal_error, mctc_stat use mctc_env_system, only : get_argument, get_variable, & & is_unix, is_windows implicit none public end module mctc_env mctc-lib-0.3.2/src/mctc/env/000077500000000000000000000000001466406626700155345ustar00rootroot00000000000000mctc-lib-0.3.2/src/mctc/env/CMakeLists.txt000066400000000000000000000013761466406626700203030ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. set(dir "${CMAKE_CURRENT_SOURCE_DIR}") list( APPEND srcs "${dir}/accuracy.f90" "${dir}/error.f90" "${dir}/system.f90" "${dir}/testing.f90" ) set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/env/accuracy.f90000066400000000000000000000024241466406626700176500ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Numerical storage size parameters for real and integer values module mctc_env_accuracy implicit none public !> Single precision real numbers integer, parameter :: sp = selected_real_kind(6) !> Double precision real numbers integer, parameter :: dp = selected_real_kind(15) !> Wanted precision integer, parameter :: wp = dp !> Char length for integers integer, parameter :: i1 = selected_int_kind(2) !> Short length for integers integer, parameter :: i2 = selected_int_kind(4) !> Length of default integers integer, parameter :: i4 = selected_int_kind(9) !> Long length for integers integer, parameter :: i8 = selected_int_kind(18) end module mctc_env_accuracy mctc-lib-0.3.2/src/mctc/env/error.f90000066400000000000000000000035231466406626700172100ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Central registry for error codes module mctc_env_error implicit none private public :: mctc_stat, error_type public :: fatal_error !> Possible error codes type :: enum_stat !> Successful run integer :: success = 0 !> Internal error: integer :: fatal = 1 end type enum_stat !> Actual enumerator for return states type(enum_stat), parameter :: mctc_stat = enum_stat() !> Error message type :: error_type !> Error code integer :: stat !> Payload of the error character(len=:), allocatable :: message end type error_type contains !> A fatal error is encountered subroutine fatal_error(error, message, stat) !> Instance of the error type(error_type), allocatable, intent(out) :: error !> A detailed message describing the error and (optionally) offering advice character(len=*), intent(in), optional :: message !> Overwrite of the error code integer, intent(in), optional :: stat allocate(error) if (present(stat)) then error%stat = stat else error%stat = mctc_stat%fatal end if if (present(message)) then error%message = message else error%message = "Fatal error" end if end subroutine fatal_error end module mctc_env_error mctc-lib-0.3.2/src/mctc/env/meson.build000066400000000000000000000012271466406626700177000ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. srcs += files( 'accuracy.f90', 'error.f90', 'system.f90', 'testing.f90', ) mctc-lib-0.3.2/src/mctc/env/system.f90000066400000000000000000000057311466406626700174060ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Module collecting commands to conveniently interface with system commands module mctc_env_system implicit none private public :: get_argument, get_variable public :: is_windows, is_unix contains !> Obtain the command line argument at a given index subroutine get_argument(idx, arg) !> Index of command line argument, range [0:command_argument_count()] integer, intent(in) :: idx !> Command line argument character(len=:), allocatable, intent(out) :: arg integer :: length, stat call get_command_argument(idx, length=length, status=stat) if (stat /= 0) then return endif allocate(character(len=length) :: arg, stat=stat) if (stat /= 0) then return endif if (length > 0) then call get_command_argument(idx, arg, status=stat) if (stat /= 0) then deallocate(arg) return end if end if end subroutine get_argument !> Obtain the value of an environment variable subroutine get_variable(var, val) !> Name of variable character(len=*), intent(in) :: var !> Value of variable character(len=:), allocatable, intent(out) :: val integer :: length, stat call get_environment_variable(var, length=length, status=stat) if (stat /= 0) then return endif allocate(character(len=length) :: val, stat=stat) if (stat /= 0) then return endif if (length > 0) then call get_environment_variable(var, val, status=stat) if (stat /= 0) then deallocate(val) return end if end if end subroutine get_variable !> Try to determine if we run on Windows and don't have POSIX compliance around function is_windows() !> Operating system seems to be Windows logical :: is_windows character(len=:), allocatable :: tmp is_windows = .false. call get_variable('OS', tmp) if (allocated(tmp)) then is_windows = index(tmp, 'Windows_NT') > 0 end if if (.not.is_windows) then call get_variable('OSTYPE', tmp) if (allocated(tmp)) then is_windows = index(tmp, 'win') > 0 .or. index(tmp, 'msys') > 0 end if end if end function is_windows !> Try to determine if we run on Unix and probably can rely on POSIX compliance function is_unix() !> Operating system seems to be Unix logical :: is_unix character(len=:), allocatable :: tmp is_unix = .not. is_windows() end function is_unix end module mctc_env_system mctc-lib-0.3.2/src/mctc/env/testing.f90000066400000000000000000000441201466406626700175320ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Provides a light-weight testing framework for usage in projects depending on !> the tool chain library. !> !> Testsuites are defined by a [[collect_interface]] returning a set of !> [[unittest_type]] objects. To create a new test use the [[new_unittest]] !> constructor, which requires a test identifier and a procedure with a !> [[test_interface]] compatible signature. The error status is communicated !> by the allocation status of an [[error_type]]. !> !> The necessary boilerplate code to setup the test entry point is just !> !>```fortran !>program tester !> use, intrinsic :: iso_fortran_env, only : error_unit !> use mctc_env_testing, only : run_testsuite, new_testsuite, testsuite_type !> use test_suite1, only : collect_suite1 !> use test_suite2, only : collect_suite2 !> implicit none !> integer :: stat, ii !> type(testsuite_type), allocatable :: testsuites(:) !> character(len=*), parameter :: fmt = '("#", *(1x, a))' !> !> stat = 0 !> !> testsuites = [ & !> & new_testsuite("suite1", collect_suite1), & !> & new_testsuite("suite2", collect_suite2) & !> & ] !> !> do ii = 1, size(testsuites) !> write(error_unit, fmt) "Testing:", testsuites(ii)%name !> call run_testsuite(testsuites(ii)%collect, error_unit, stat) !> end do !> !> if (stat > 0) then !> write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" !> error stop !> end if !> !>end program tester !>``` !> !> Every test is defined in a separate module using a ``collect`` function, which !> is exported and added to the ``testsuites`` array in the test runner. !> All test have a simple interface with just an allocatable [[error_type]] as !> output to provide the test results. !> !>```fortran !>module test_suite1 !> use mctc_env_testing, only : new_unittest, unittest_type, error_type, check !> implicit none !> private !> !> public :: collect_suite1 !> !>contains !> !>!> Collect all exported unit tests !>subroutine collect_suite1(testsuite) !> !> Collection of tests !> type(unittest_type), allocatable, intent(out) :: testsuite(:) !> !> testsuite = [ & !> & new_unittest("valid", test_valid), & !> & new_unittest("invalid", test_invalid, should_fail=.true.) & !> & ] !> !>end subroutine collect_suite1 !> !>subroutine test_valid(error) !> type(error_type), allocatable, intent(out) :: error !> ! ... !>end subroutine test_valid !> !>subroutine test_invalid(error) !> type(error_type), allocatable, intent(out) :: error !> ! ... !>end subroutine test_invalid !> !>end module test_suite1 !>``` !> !> For an example setup checkout the ``test/`` directory in this project. module mctc_env_testing use mctc_env_error, only : error_type, mctc_stat use mctc_env_accuracy, only : sp, dp, i1, i2, i4, i8 implicit none private public :: run_testsuite, run_selected, new_unittest, new_testsuite public :: select_test, select_suite public :: unittest_type, testsuite_type, error_type public :: check, test_failed public :: test_interface, collect_interface interface check module procedure :: check_stat module procedure :: check_logical module procedure :: check_float_sp module procedure :: check_float_dp module procedure :: check_int_i1 module procedure :: check_int_i2 module procedure :: check_int_i4 module procedure :: check_int_i8 module procedure :: check_bool module procedure :: check_string end interface check abstract interface !> Entry point for tests subroutine test_interface(error) import :: error_type !> Error handling type(error_type), allocatable, intent(out) :: error end subroutine test_interface end interface !> Declaration of a unit test type :: unittest_type !> Name of the test character(len=:), allocatable :: name !> Entry point of the test procedure(test_interface), pointer, nopass :: test => null() !> Whether test is supposed to fail logical :: should_fail = .false. end type unittest_type abstract interface !> Collect all tests subroutine collect_interface(testsuite) import :: unittest_type !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) end subroutine collect_interface end interface !> Collection of unit tests type :: testsuite_type !> Name of the testsuite character(len=:), allocatable :: name !> Entry point of the test procedure(collect_interface), pointer, nopass :: collect => null() end type testsuite_type character(len=*), parameter :: fmt = '(1x, *(1x, a))' character(len=*), parameter :: indent = repeat(" ", 5) // repeat(".", 3) contains !> Driver for testsuite subroutine run_testsuite(collect, unit, stat, parallel) !> Collect tests procedure(collect_interface) :: collect !> Unit for IO integer, intent(in) :: unit !> Number of failed tests integer, intent(inout) :: stat !> Run tests in parallel logical, intent(in), optional :: parallel type(unittest_type), allocatable :: testsuite(:) logical :: parallelize integer :: ii parallelize = .false. if (present(parallel)) parallelize = parallel call collect(testsuite) !$omp parallel do shared(testsuite, unit) reduction(+:stat) if(parallelize) do ii = 1, size(testsuite) !$omp critical(mctc_env_testsuite) write(unit, '(1x, 3(1x, a), 1x, "(", i0, "/", i0, ")")') & & "Starting", testsuite(ii)%name, "...", ii, size(testsuite) !$omp end critical(mctc_env_testsuite) call run_unittest(testsuite(ii), unit, stat) end do end subroutine run_testsuite !> Driver for selective testing subroutine run_selected(collect, name, unit, stat) !> Collect tests procedure(collect_interface) :: collect !> Name of the selected test character(len=*), intent(in) :: name !> Unit for IO integer, intent(in) :: unit !> Number of failed tests integer, intent(inout) :: stat type(unittest_type), allocatable :: testsuite(:) integer :: ii call collect(testsuite) ii = select_test(testsuite, name) if (ii > 0 .and. ii <= size(testsuite)) then call run_unittest(testsuite(ii), unit, stat) else write(unit, fmt) "Available tests:" do ii = 1, size(testsuite) write(unit, fmt) "-", testsuite(ii)%name end do stat = -huge(ii) end if end subroutine run_selected !> Run a selected unit test subroutine run_unittest(test, unit, stat) !> Unit test type(unittest_type), intent(in) :: test !> Unit for IO integer, intent(in) :: unit !> Number of failed tests integer, intent(inout) :: stat type(error_type), allocatable :: error call test%test(error) !$omp critical(mctc_env_testsuite) if (allocated(error) .neqv. test%should_fail) then if (test%should_fail) then write(unit, fmt) indent, test%name, "[UNEXPECTED PASS]" else write(unit, fmt) indent, test%name, "[FAILED]" end if stat = stat + 1 else if (test%should_fail) then write(unit, fmt) indent, test%name, "[EXPECTED FAIL]" else write(unit, fmt) indent, test%name, "[PASSED]" end if end if if (allocated(error)) then write(unit, fmt) "Message:", error%message end if !$omp end critical(mctc_env_testsuite) end subroutine run_unittest !> Select a unit test from all available tests function select_test(tests, name) result(pos) !> Name identifying the test suite character(len=*), intent(in) :: name !> Available unit tests type(unittest_type) :: tests(:) !> Selected test suite integer :: pos integer :: it pos = 0 do it = 1, size(tests) if (name == tests(it)%name) then pos = it exit end if end do end function select_test !> Select a test suite from all available suites function select_suite(suites, name) result(pos) !> Name identifying the test suite character(len=*), intent(in) :: name !> Available test suites type(testsuite_type) :: suites(:) !> Selected test suite integer :: pos integer :: it pos = 0 do it = 1, size(suites) if (name == suites(it)%name) then pos = it exit end if end do end function select_suite !> Register a new unit test function new_unittest(name, test, should_fail) result(self) !> Name of the test character(len=*), intent(in) :: name !> Entry point for the test procedure(test_interface) :: test !> Whether test is supposed to error or not logical, intent(in), optional :: should_fail !> Newly registered test type(unittest_type) :: self self%name = name self%test => test if (present(should_fail)) self%should_fail = should_fail end function new_unittest !> Register a new testsuite function new_testsuite(name, collect) result(self) !> Name of the testsuite character(len=*), intent(in) :: name !> Entry point to collect tests procedure(collect_interface) :: collect !> Newly registered testsuite type(testsuite_type) :: self self%name = name self%collect => collect end function new_testsuite subroutine check_stat(error, stat, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Status of operation integer, intent(in) :: stat !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (stat /= mctc_stat%success) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Non-zero exit code encountered", more) end if end if end subroutine check_stat subroutine check_logical(error, expression, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Result of logical operator logical, intent(in) :: expression !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (.not.expression) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Condition not fullfilled", more) end if end if end subroutine check_logical subroutine check_float_dp(error, actual, expected, message, more, thr, rel) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found floating point value real(dp), intent(in) :: actual !> Expected floating point value real(dp), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more !> Allowed threshold for matching floating point values real(dp), intent(in), optional :: thr !> Check for relative errors instead logical, intent(in), optional :: rel logical :: relative real(dp) :: diff, threshold if (present(thr)) then threshold = thr else threshold = epsilon(expected) end if if (present(rel)) then relative = rel else relative = .false. end if if (relative) then diff = abs(actual - expected) / expected else diff = abs(actual - expected) end if if (diff > threshold) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Floating point value missmatch", more) end if end if end subroutine check_float_dp subroutine check_float_sp(error, actual, expected, message, more, thr, rel) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found floating point value real(sp), intent(in) :: actual !> Expected floating point value real(sp), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more !> Allowed threshold for matching floating point values real(sp), intent(in), optional :: thr !> Check for relative errors instead logical, intent(in), optional :: rel logical :: relative real(sp) :: diff, threshold if (present(thr)) then threshold = thr else threshold = epsilon(expected) end if if (present(rel)) then relative = rel else relative = .false. end if if (relative) then diff = abs(actual - expected) / expected else diff = abs(actual - expected) end if if (diff > threshold) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Floating point value missmatch", more) end if end if end subroutine check_float_sp subroutine check_int_i1(error, actual, expected, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found integer value integer(i1), intent(in) :: actual !> Expected integer value integer(i1), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (expected /= actual) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Integer value missmatch", more) end if end if end subroutine check_int_i1 subroutine check_int_i2(error, actual, expected, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found integer value integer(i2), intent(in) :: actual !> Expected integer value integer(i2), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (expected /= actual) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Integer value missmatch", more) end if end if end subroutine check_int_i2 subroutine check_int_i4(error, actual, expected, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found integer value integer(i4), intent(in) :: actual !> Expected integer value integer(i4), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (expected /= actual) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Integer value missmatch", more) end if end if end subroutine check_int_i4 subroutine check_int_i8(error, actual, expected, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found integer value integer(i8), intent(in) :: actual !> Expected integer value integer(i8), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (expected /= actual) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Integer value missmatch", more) end if end if end subroutine check_int_i8 subroutine check_bool(error, actual, expected, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found boolean value logical, intent(in) :: actual !> Expected boolean value logical, intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (expected .neqv. actual) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Logical value missmatch", more) end if end if end subroutine check_bool subroutine check_string(error, actual, expected, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> Found boolean value character(len=*), intent(in) :: actual !> Expected boolean value character(len=*), intent(in) :: expected !> A detailed message describing the error character(len=*), intent(in), optional :: message !> Another line of error message character(len=*), intent(in), optional :: more if (expected /= actual) then if (present(message)) then call test_failed(error, message, more) else call test_failed(error, "Character value missmatch", more) end if end if end subroutine check_string subroutine test_failed(error, message, more) !> Error handling type(error_type), allocatable, intent(out) :: error !> A detailed message describing the error character(len=*), intent(in) :: message !> Another line of error message character(len=*), intent(in), optional :: more allocate(error) error%stat = mctc_stat%fatal if (present(more)) then error%message = message // new_line('a') // more else error%message = message end if end subroutine test_failed end module mctc_env_testing mctc-lib-0.3.2/src/mctc/io.f90000066400000000000000000000032051466406626700156730ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Input and output module of the tool chain library. !> !> This module exports the basic [[structure_type]] as well as routines !> to read it from a file or formatted unit ([[read_structure]]) or write !> it to a formatted unit ([[write_structure]]). !> !> Both [[read_structure]] and [[write_structure]] take format hints from !> the filetype enumerator. File names can be translated to the respective !> enumerator by using the [[get_filetype]] function. This can be useful in !> case the caller routine wants to open the formatted unit itself or uses !> a non-standard file extension. module mctc_io use mctc_io_filetype, only : filetype, get_filetype use mctc_io_read, only : read_structure use mctc_io_structure, only : structure_type, new_structure, new use mctc_io_symbols, only : to_symbol, to_number use mctc_io_write, only : write_structure implicit none private public :: filetype, get_filetype public :: read_structure, write_structure public :: structure_type, new_structure, new public :: to_symbol, to_number contains end module mctc_io mctc-lib-0.3.2/src/mctc/io/000077500000000000000000000000001466406626700153535ustar00rootroot00000000000000mctc-lib-0.3.2/src/mctc/io/CMakeLists.txt000066400000000000000000000017601466406626700201170ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. add_subdirectory("read") add_subdirectory("structure") add_subdirectory("write") set(dir "${CMAKE_CURRENT_SOURCE_DIR}") list( APPEND srcs "${dir}/codata2018.f90" "${dir}/constants.f90" "${dir}/convert.f90" "${dir}/filetype.f90" "${dir}/math.f90" "${dir}/read.f90" "${dir}/resize.f90" "${dir}/structure.f90" "${dir}/symbols.f90" "${dir}/utils.f90" "${dir}/write.f90" ) set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/io/codata2018.f90000066400000000000000000001240261466406626700174460ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Automatically generated from 2018 CODATA NIST file: !> https://physics.nist.gov/cuu/Constants/Table/allascii.txt !> !> Based on https://github.com/vmagnin/fundamental_constants. module mctc_io_codata2018 use mctc_env, only : wp implicit none public !> alpha particle-electron mass ratio (dimensionless) real(wp), parameter :: alpha_particle_electron_mass_ratio = 7294.29954142_wp !> alpha particle mass (kg) real(wp), parameter :: alpha_particle_mass = 6.6446573357e-27_wp !> alpha particle mass energy equivalent (J) real(wp), parameter :: alpha_particle_mass_energy_equivalent = 5.9719201914e-10_wp !> alpha particle mass energy equivalent in MeV (MeV) real(wp), parameter :: alpha_particle_mass_energy_equivalent_in_MeV = 3727.3794066_wp !> alpha particle mass in u (u) real(wp), parameter :: alpha_particle_mass_in_u = 4.001506179127_wp !> alpha particle molar mass (kg mol^-1) real(wp), parameter :: alpha_particle_molar_mass = 4.0015061777e-3_wp !> alpha particle-proton mass ratio (dimensionless) real(wp), parameter :: alpha_particle_proton_mass_ratio = 3.97259969009_wp !> alpha particle relative atomic mass (dimensionless) real(wp), parameter :: alpha_particle_relative_atomic_mass = 4.001506179127_wp !> Angstrom star (m) real(wp), parameter :: Angstrom_star = 1.00001495e-10_wp !> atomic mass constant (kg) real(wp), parameter :: atomic_mass_constant = 1.66053906660e-27_wp !> atomic mass constant energy equivalent (J) real(wp), parameter :: atomic_mass_constant_energy_equivalent = 1.49241808560e-10_wp !> atomic mass constant energy equivalent in MeV (MeV) real(wp), parameter :: atomic_mass_constant_energy_equivalent_in_MeV = 931.49410242_wp !> atomic mass unit-electron volt relationship (eV) real(wp), parameter :: atomic_mass_unit_electron_volt_relationship = 9.3149410242e8_wp !> atomic mass unit-hartree relationship (E_h) real(wp), parameter :: atomic_mass_unit_hartree_relationship = 3.4231776874e7_wp !> atomic mass unit-hertz relationship (Hz) real(wp), parameter :: atomic_mass_unit_hertz_relationship = 2.25234271871e23_wp !> atomic mass unit-inverse meter relationship (m^-1) real(wp), parameter :: atomic_mass_unit_inverse_meter_relationship = 7.5130066104e14_wp !> atomic mass unit-joule relationship (J) real(wp), parameter :: atomic_mass_unit_joule_relationship = 1.49241808560e-10_wp !> atomic mass unit-kelvin relationship (K) real(wp), parameter :: atomic_mass_unit_kelvin_relationship = 1.08095401916e13_wp !> atomic mass unit-kilogram relationship (kg) real(wp), parameter :: atomic_mass_unit_kilogram_relationship = 1.66053906660e-27_wp !> atomic unit of 1st hyperpolarizability (C^3 m^3 J^-2) real(wp), parameter :: atomic_unit_of_1st_hyperpolarizability = 3.2063613061e-53_wp !> atomic unit of 2nd hyperpolarizability (C^4 m^4 J^-3) real(wp), parameter :: atomic_unit_of_2nd_hyperpolarizability = 6.2353799905e-65_wp !> atomic unit of action (J s) real(wp), parameter :: atomic_unit_of_action = 1.054571817e-34_wp !> atomic unit of charge (C) real(wp), parameter :: atomic_unit_of_charge = 1.602176634e-19_wp !> atomic unit of charge density (C m^-3) real(wp), parameter :: atomic_unit_of_charge_density = 1.08120238457e12_wp !> atomic unit of current (A) real(wp), parameter :: atomic_unit_of_current = 6.623618237510e-3_wp !> atomic unit of electric dipole mom. (C m) real(wp), parameter :: atomic_unit_of_electric_dipole_mom_ = 8.4783536255e-30_wp !> atomic unit of electric field (V m^-1) real(wp), parameter :: atomic_unit_of_electric_field = 5.14220674763e11_wp !> atomic unit of electric field gradient (V m^-2) real(wp), parameter :: atomic_unit_of_electric_field_gradient = 9.7173624292e21_wp !> atomic unit of electric polarizability (C^2 m^2 J^-1) real(wp), parameter :: atomic_unit_of_electric_polarizability = 1.64877727436e-41_wp !> atomic unit of electric potential (V) real(wp), parameter :: atomic_unit_of_electric_potential = 27.211386245988_wp !> atomic unit of electric quadrupole mom. (C m^2) real(wp), parameter :: atomic_unit_of_electric_quadrupole_mom_ = 4.4865515246e-40_wp !> atomic unit of energy (J) real(wp), parameter :: atomic_unit_of_energy = 4.3597447222071e-18_wp !> atomic unit of force (N) real(wp), parameter :: atomic_unit_of_force = 8.2387234983e-8_wp !> atomic unit of length (m) real(wp), parameter :: atomic_unit_of_length = 5.29177210903e-11_wp !> atomic unit of mag. dipole mom. (J T^-1) real(wp), parameter :: atomic_unit_of_mag__dipole_mom_ = 1.85480201566e-23_wp !> atomic unit of mag. flux density (T) real(wp), parameter :: atomic_unit_of_mag__flux_density = 2.35051756758e5_wp !> atomic unit of magnetizability (J T^-2) real(wp), parameter :: atomic_unit_of_magnetizability = 7.8910366008e-29_wp !> atomic unit of mass (kg) real(wp), parameter :: atomic_unit_of_mass = 9.1093837015e-31_wp !> atomic unit of momentum (kg m s^-1) real(wp), parameter :: atomic_unit_of_momentum = 1.99285191410e-24_wp !> atomic unit of permittivity (F m^-1) real(wp), parameter :: atomic_unit_of_permittivity = 1.11265005545e-10_wp !> atomic unit of time (s) real(wp), parameter :: atomic_unit_of_time = 2.4188843265857e-17_wp !> atomic unit of velocity (m s^-1) real(wp), parameter :: atomic_unit_of_velocity = 2.18769126364e6_wp !> Avogadro constant (mol^-1) real(wp), parameter :: Avogadro_constant = 6.02214076e23_wp !> Bohr magneton (J T^-1) real(wp), parameter :: Bohr_magneton = 9.2740100783e-24_wp !> Bohr magneton in eV/T (eV T^-1) real(wp), parameter :: Bohr_magneton_in_eV_T = 5.7883818060e-5_wp !> Bohr magneton in Hz/T (Hz T^-1) real(wp), parameter :: Bohr_magneton_in_Hz_T = 1.39962449361e10_wp !> Bohr magneton in inverse meter per tesla (m^-1 T^-1) real(wp), parameter :: Bohr_magneton_in_inverse_meter_per_tesla = 46.686447783_wp !> Bohr magneton in K/T (K T^-1) real(wp), parameter :: Bohr_magneton_in_K_T = 0.67171381563_wp !> Bohr radius (m) real(wp), parameter :: Bohr_radius = 5.29177210903e-11_wp !> Boltzmann constant (J K^-1) real(wp), parameter :: Boltzmann_constant = 1.380649e-23_wp !> Boltzmann constant in eV/K (eV K^-1) real(wp), parameter :: Boltzmann_constant_in_eV_K = 8.617333262e-5_wp !> Boltzmann constant in Hz/K (Hz K^-1) real(wp), parameter :: Boltzmann_constant_in_Hz_K = 2.083661912e10_wp !> Boltzmann constant in inverse meter per kelvin (m^-1 K^-1) real(wp), parameter :: Boltzmann_constant_in_inverse_meter_per_kelvin = 69.50348004_wp !> characteristic impedance of vacuum (ohm) real(wp), parameter :: characteristic_impedance_of_vacuum = 376.730313668_wp !> classical electron radius (m) real(wp), parameter :: classical_electron_radius = 2.8179403262e-15_wp !> Compton wavelength (m) real(wp), parameter :: Compton_wavelength = 2.42631023867e-12_wp !> conductance quantum (S) real(wp), parameter :: conductance_quantum = 7.748091729e-5_wp !> conventional value of ampere-90 (A) real(wp), parameter :: conventional_value_of_ampere_90 = 1.00000008887_wp !> conventional value of coulomb-90 (C) real(wp), parameter :: conventional_value_of_coulomb_90 = 1.00000008887_wp !> conventional value of farad-90 (F) real(wp), parameter :: conventional_value_of_farad_90 = 0.99999998220_wp !> conventional value of henry-90 (H) real(wp), parameter :: conventional_value_of_henry_90 = 1.00000001779_wp !> conventional value of Josephson constant (Hz V^-1) real(wp), parameter :: conventional_value_of_Josephson_constant = 483597.9e9_wp !> conventional value of ohm-90 (ohm) real(wp), parameter :: conventional_value_of_ohm_90 = 1.00000001779_wp !> conventional value of volt-90 (V) real(wp), parameter :: conventional_value_of_volt_90 = 1.00000010666_wp !> conventional value of von Klitzing constant (ohm) real(wp), parameter :: conventional_value_of_von_Klitzing_constant = 25812.807_wp !> conventional value of watt-90 (W) real(wp), parameter :: conventional_value_of_watt_90 = 1.00000019553_wp !> Copper x unit (m) real(wp), parameter :: Copper_x_unit = 1.00207697e-13_wp !> deuteron-electron mag. mom. ratio (dimensionless) real(wp), parameter :: deuteron_electron_mag__mom__ratio = -4.664345551e-4_wp !> deuteron-electron mass ratio (dimensionless) real(wp), parameter :: deuteron_electron_mass_ratio = 3670.48296788_wp !> deuteron g factor (dimensionless) real(wp), parameter :: deuteron_g_factor = 0.8574382338_wp !> deuteron mag. mom. (J T^-1) real(wp), parameter :: deuteron_mag__mom_ = 4.330735094e-27_wp !> deuteron mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: deuteron_mag__mom__to_Bohr_magneton_ratio = 4.669754570e-4_wp !> deuteron mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: deuteron_mag__mom__to_nuclear_magneton_ratio = 0.8574382338_wp !> deuteron mass (kg) real(wp), parameter :: deuteron_mass = 3.3435837724e-27_wp !> deuteron mass energy equivalent (J) real(wp), parameter :: deuteron_mass_energy_equivalent = 3.00506323102e-10_wp !> deuteron mass energy equivalent in MeV (MeV) real(wp), parameter :: deuteron_mass_energy_equivalent_in_MeV = 1875.61294257_wp !> deuteron mass in u (u) real(wp), parameter :: deuteron_mass_in_u = 2.013553212745_wp !> deuteron molar mass (kg mol^-1) real(wp), parameter :: deuteron_molar_mass = 2.01355321205e-3_wp !> deuteron-neutron mag. mom. ratio (dimensionless) real(wp), parameter :: deuteron_neutron_mag__mom__ratio = -0.44820653_wp !> deuteron-proton mag. mom. ratio (dimensionless) real(wp), parameter :: deuteron_proton_mag__mom__ratio = 0.30701220939_wp !> deuteron-proton mass ratio (dimensionless) real(wp), parameter :: deuteron_proton_mass_ratio = 1.99900750139_wp !> deuteron relative atomic mass (dimensionless) real(wp), parameter :: deuteron_relative_atomic_mass = 2.013553212745_wp !> deuteron rms charge radius (m) real(wp), parameter :: deuteron_rms_charge_radius = 2.12799e-15_wp !> electron charge to mass quotient (C kg^-1) real(wp), parameter :: electron_charge_to_mass_quotient = -1.75882001076e11_wp !> electron-deuteron mag. mom. ratio (dimensionless) real(wp), parameter :: electron_deuteron_mag__mom__ratio = -2143.9234915_wp !> electron-deuteron mass ratio (dimensionless) real(wp), parameter :: electron_deuteron_mass_ratio = 2.724437107462e-4_wp !> electron g factor (dimensionless) real(wp), parameter :: electron_g_factor = -2.00231930436256_wp !> electron gyromag. ratio (s^-1 T^-1) real(wp), parameter :: electron_gyromag__ratio = 1.76085963023e11_wp !> electron gyromag. ratio in MHz/T (MHz T^-1) real(wp), parameter :: electron_gyromag__ratio_in_MHz_T = 28024.9514242_wp !> electron-helion mass ratio (dimensionless) real(wp), parameter :: electron_helion_mass_ratio = 1.819543074573e-4_wp !> electron mag. mom. (J T^-1) real(wp), parameter :: electron_mag__mom_ = -9.2847647043e-24_wp !> electron mag. mom. anomaly (dimensionless) real(wp), parameter :: electron_mag__mom__anomaly = 1.15965218128e-3_wp !> electron mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: electron_mag__mom__to_Bohr_magneton_ratio = -1.00115965218128_wp !> electron mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: electron_mag__mom__to_nuclear_magneton_ratio = -1838.28197188_wp !> electron mass (kg) real(wp), parameter :: electron_mass = 9.1093837015e-31_wp !> electron mass energy equivalent (J) real(wp), parameter :: electron_mass_energy_equivalent = 8.1871057769e-14_wp !> electron mass energy equivalent in MeV (MeV) real(wp), parameter :: electron_mass_energy_equivalent_in_MeV = 0.51099895000_wp !> electron mass in u (u) real(wp), parameter :: electron_mass_in_u = 5.48579909065e-4_wp !> electron molar mass (kg mol^-1) real(wp), parameter :: electron_molar_mass = 5.4857990888e-7_wp !> electron-muon mag. mom. ratio (dimensionless) real(wp), parameter :: electron_muon_mag__mom__ratio = 206.7669883_wp !> electron-muon mass ratio (dimensionless) real(wp), parameter :: electron_muon_mass_ratio = 4.83633169e-3_wp !> electron-neutron mag. mom. ratio (dimensionless) real(wp), parameter :: electron_neutron_mag__mom__ratio = 960.92050_wp !> electron-neutron mass ratio (dimensionless) real(wp), parameter :: electron_neutron_mass_ratio = 5.4386734424e-4_wp !> electron-proton mag. mom. ratio (dimensionless) real(wp), parameter :: electron_proton_mag__mom__ratio = -658.21068789_wp !> electron-proton mass ratio (dimensionless) real(wp), parameter :: electron_proton_mass_ratio = 5.44617021487e-4_wp !> electron relative atomic mass (dimensionless) real(wp), parameter :: electron_relative_atomic_mass = 5.48579909065e-4_wp !> electron-tau mass ratio (dimensionless) real(wp), parameter :: electron_tau_mass_ratio = 2.87585e-4_wp !> electron to alpha particle mass ratio (dimensionless) real(wp), parameter :: electron_to_alpha_particle_mass_ratio = 1.370933554787e-4_wp !> electron to shielded helion mag. mom. ratio (dimensionless) real(wp), parameter :: electron_to_shielded_helion_mag__mom__ratio = 864.058257_wp !> electron to shielded proton mag. mom. ratio (dimensionless) real(wp), parameter :: electron_to_shielded_proton_mag__mom__ratio = -658.2275971_wp !> electron-triton mass ratio (dimensionless) real(wp), parameter :: electron_triton_mass_ratio = 1.819200062251e-4_wp !> electron volt (J) real(wp), parameter :: electron_volt = 1.602176634e-19_wp !> electron volt-atomic mass unit relationship (u) real(wp), parameter :: electron_volt_atomic_mass_unit_relationship = 1.07354410233e-9_wp !> electron volt-hartree relationship (E_h) real(wp), parameter :: electron_volt_hartree_relationship = 3.6749322175655e-2_wp !> electron volt-hertz relationship (Hz) real(wp), parameter :: electron_volt_hertz_relationship = 2.417989242e14_wp !> electron volt-inverse meter relationship (m^-1) real(wp), parameter :: electron_volt_inverse_meter_relationship = 8.065543937e5_wp !> electron volt-joule relationship (J) real(wp), parameter :: electron_volt_joule_relationship = 1.602176634e-19_wp !> electron volt-kelvin relationship (K) real(wp), parameter :: electron_volt_kelvin_relationship = 1.160451812e4_wp !> electron volt-kilogram relationship (kg) real(wp), parameter :: electron_volt_kilogram_relationship = 1.782661921e-36_wp !> elementary charge (C) real(wp), parameter :: elementary_charge = 1.602176634e-19_wp !> elementary charge over h-bar (A J^-1) real(wp), parameter :: elementary_charge_over_h_bar = 1.519267447e15_wp !> Faraday constant (C mol^-1) real(wp), parameter :: Faraday_constant = 96485.33212_wp !> Fermi coupling constant (GeV^-2) real(wp), parameter :: Fermi_coupling_constant = 1.1663787e-5_wp !> fine-structure constant (dimensionless) real(wp), parameter :: fine_structure_constant = 7.2973525693e-3_wp !> first radiation constant (W m^2) real(wp), parameter :: first_radiation_constant = 3.741771852e-16_wp !> first radiation constant for spectral radiance (W m^2 sr^-1) real(wp), parameter :: first_radiation_constant_for_spectral_radiance = 1.191042972e-16_wp !> hartree-atomic mass unit relationship (u) real(wp), parameter :: hartree_atomic_mass_unit_relationship = 2.92126232205e-8_wp !> hartree-electron volt relationship (eV) real(wp), parameter :: hartree_electron_volt_relationship = 27.211386245988_wp !> Hartree energy (J) real(wp), parameter :: Hartree_energy = 4.3597447222071e-18_wp !> Hartree energy in eV (eV) real(wp), parameter :: Hartree_energy_in_eV = 27.211386245988_wp !> hartree-hertz relationship (Hz) real(wp), parameter :: hartree_hertz_relationship = 6.579683920502e15_wp !> hartree-inverse meter relationship (m^-1) real(wp), parameter :: hartree_inverse_meter_relationship = 2.1947463136320e7_wp !> hartree-joule relationship (J) real(wp), parameter :: hartree_joule_relationship = 4.3597447222071e-18_wp !> hartree-kelvin relationship (K) real(wp), parameter :: hartree_kelvin_relationship = 3.1577502480407e5_wp !> hartree-kilogram relationship (kg) real(wp), parameter :: hartree_kilogram_relationship = 4.8508702095432e-35_wp !> helion-electron mass ratio (dimensionless) real(wp), parameter :: helion_electron_mass_ratio = 5495.88528007_wp !> helion g factor (dimensionless) real(wp), parameter :: helion_g_factor = -4.255250615_wp !> helion mag. mom. (J T^-1) real(wp), parameter :: helion_mag__mom_ = -1.074617532e-26_wp !> helion mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: helion_mag__mom__to_Bohr_magneton_ratio = -1.158740958e-3_wp !> helion mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: helion_mag__mom__to_nuclear_magneton_ratio = -2.127625307_wp !> helion mass (kg) real(wp), parameter :: helion_mass = 5.0064127796e-27_wp !> helion mass energy equivalent (J) real(wp), parameter :: helion_mass_energy_equivalent = 4.4995394125e-10_wp !> helion mass energy equivalent in MeV (MeV) real(wp), parameter :: helion_mass_energy_equivalent_in_MeV = 2808.39160743_wp !> helion mass in u (u) real(wp), parameter :: helion_mass_in_u = 3.014932247175_wp !> helion molar mass (kg mol^-1) real(wp), parameter :: helion_molar_mass = 3.01493224613e-3_wp !> helion-proton mass ratio (dimensionless) real(wp), parameter :: helion_proton_mass_ratio = 2.99315267167_wp !> helion relative atomic mass (dimensionless) real(wp), parameter :: helion_relative_atomic_mass = 3.014932247175_wp !> helion shielding shift (dimensionless) real(wp), parameter :: helion_shielding_shift = 5.996743e-5_wp !> hertz-atomic mass unit relationship (u) real(wp), parameter :: hertz_atomic_mass_unit_relationship = 4.4398216652e-24_wp !> hertz-electron volt relationship (eV) real(wp), parameter :: hertz_electron_volt_relationship = 4.135667696e-15_wp !> hertz-hartree relationship (E_h) real(wp), parameter :: hertz_hartree_relationship = 1.5198298460570e-16_wp !> hertz-inverse meter relationship (m^-1) real(wp), parameter :: hertz_inverse_meter_relationship = 3.335640951e-9_wp !> hertz-joule relationship (J) real(wp), parameter :: hertz_joule_relationship = 6.62607015e-34_wp !> hertz-kelvin relationship (K) real(wp), parameter :: hertz_kelvin_relationship = 4.799243073e-11_wp !> hertz-kilogram relationship (kg) real(wp), parameter :: hertz_kilogram_relationship = 7.372497323e-51_wp !> hyperfine transition frequency of Cs-133 (Hz) real(wp), parameter :: hyperfine_transition_frequency_of_Cs_133 = 9192631770e0_wp !> inverse fine-structure constant (dimensionless) real(wp), parameter :: inverse_fine_structure_constant = 137.035999084_wp !> inverse meter-atomic mass unit relationship (u) real(wp), parameter :: inverse_meter_atomic_mass_unit_relationship = 1.33102505010e-15_wp !> inverse meter-electron volt relationship (eV) real(wp), parameter :: inverse_meter_electron_volt_relationship = 1.239841984e-6_wp !> inverse meter-hartree relationship (E_h) real(wp), parameter :: inverse_meter_hartree_relationship = 4.5563352529120e-8_wp !> inverse meter-hertz relationship (Hz) real(wp), parameter :: inverse_meter_hertz_relationship = 299792458e0_wp !> inverse meter-joule relationship (J) real(wp), parameter :: inverse_meter_joule_relationship = 1.986445857e-25_wp !> inverse meter-kelvin relationship (K) real(wp), parameter :: inverse_meter_kelvin_relationship = 1.438776877e-2_wp !> inverse meter-kilogram relationship (kg) real(wp), parameter :: inverse_meter_kilogram_relationship = 2.210219094e-42_wp !> inverse of conductance quantum (ohm) real(wp), parameter :: inverse_of_conductance_quantum = 12906.40372_wp !> Josephson constant (Hz V^-1) real(wp), parameter :: Josephson_constant = 483597.8484e9_wp !> joule-atomic mass unit relationship (u) real(wp), parameter :: joule_atomic_mass_unit_relationship = 6.7005352565e9_wp !> joule-electron volt relationship (eV) real(wp), parameter :: joule_electron_volt_relationship = 6.241509074e18_wp !> joule-hartree relationship (E_h) real(wp), parameter :: joule_hartree_relationship = 2.2937122783963e17_wp !> joule-hertz relationship (Hz) real(wp), parameter :: joule_hertz_relationship = 1.509190179e33_wp !> joule-inverse meter relationship (m^-1) real(wp), parameter :: joule_inverse_meter_relationship = 5.034116567e24_wp !> joule-kelvin relationship (K) real(wp), parameter :: joule_kelvin_relationship = 7.242970516e22_wp !> joule-kilogram relationship (kg) real(wp), parameter :: joule_kilogram_relationship = 1.112650056e-17_wp !> kelvin-atomic mass unit relationship (u) real(wp), parameter :: kelvin_atomic_mass_unit_relationship = 9.2510873014e-14_wp !> kelvin-electron volt relationship (eV) real(wp), parameter :: kelvin_electron_volt_relationship = 8.617333262e-5_wp !> kelvin-hartree relationship (E_h) real(wp), parameter :: kelvin_hartree_relationship = 3.1668115634556e-6_wp !> kelvin-hertz relationship (Hz) real(wp), parameter :: kelvin_hertz_relationship = 2.083661912e10_wp !> kelvin-inverse meter relationship (m^-1) real(wp), parameter :: kelvin_inverse_meter_relationship = 69.50348004_wp !> kelvin-joule relationship (J) real(wp), parameter :: kelvin_joule_relationship = 1.380649e-23_wp !> kelvin-kilogram relationship (kg) real(wp), parameter :: kelvin_kilogram_relationship = 1.536179187e-40_wp !> kilogram-atomic mass unit relationship (u) real(wp), parameter :: kilogram_atomic_mass_unit_relationship = 6.0221407621e26_wp !> kilogram-electron volt relationship (eV) real(wp), parameter :: kilogram_electron_volt_relationship = 5.609588603e35_wp !> kilogram-hartree relationship (E_h) real(wp), parameter :: kilogram_hartree_relationship = 2.0614857887409e34_wp !> kilogram-hertz relationship (Hz) real(wp), parameter :: kilogram_hertz_relationship = 1.356392489e50_wp !> kilogram-inverse meter relationship (m^-1) real(wp), parameter :: kilogram_inverse_meter_relationship = 4.524438335e41_wp !> kilogram-joule relationship (J) real(wp), parameter :: kilogram_joule_relationship = 8.987551787e16_wp !> kilogram-kelvin relationship (K) real(wp), parameter :: kilogram_kelvin_relationship = 6.509657260e39_wp !> lattice parameter of silicon (m) real(wp), parameter :: lattice_parameter_of_silicon = 5.431020511e-10_wp !> lattice spacing of ideal Si (220) (m) real(wp), parameter :: lattice_spacing_of_ideal_Si_220 = 1.920155716e-10_wp !> Loschmidt constant (273.15 K, 100 kPa) (m^-3) real(wp), parameter :: Loschmidt_constant_273_15_K__100_kPa = 2.651645804e25_wp !> Loschmidt constant (273.15 K, 101.325 kPa) (m^-3) real(wp), parameter :: Loschmidt_constant_273_15_K__101_325_kPa = 2.686780111e25_wp !> luminous efficacy (lm W^-1) real(wp), parameter :: luminous_efficacy = 683e0_wp !> mag. flux quantum (Wb) real(wp), parameter :: mag__flux_quantum = 2.067833848e-15_wp !> molar gas constant (J mol^-1 K^-1) real(wp), parameter :: molar_gas_constant = 8.314462618_wp !> molar mass constant (kg mol^-1) real(wp), parameter :: molar_mass_constant = 0.99999999965e-3_wp !> molar mass of carbon-12 (kg mol^-1) real(wp), parameter :: molar_mass_of_carbon_12 = 11.9999999958e-3_wp !> molar Planck constant (J Hz^-1 mol^-1) real(wp), parameter :: molar_Planck_constant = 3.990312712e-10_wp !> molar volume of ideal gas (273.15 K, 100 kPa) (m^3 mol^-1) real(wp), parameter :: molar_volume_of_ideal_gas_273_15_K__100_kPa = 22.71095464e-3_wp !> molar volume of ideal gas (273.15 K, 101.325 kPa) (m^3 mol^-1) real(wp), parameter :: molar_volume_of_ideal_gas_273_15_K__101_325_kPa = 22.41396954e-3_wp !> molar volume of silicon (m^3 mol^-1) real(wp), parameter :: molar_volume_of_silicon = 1.205883199e-5_wp !> Molybdenum x unit (m) real(wp), parameter :: Molybdenum_x_unit = 1.00209952e-13_wp !> muon Compton wavelength (m) real(wp), parameter :: muon_Compton_wavelength = 1.173444110e-14_wp !> muon-electron mass ratio (dimensionless) real(wp), parameter :: muon_electron_mass_ratio = 206.7682830_wp !> muon g factor (dimensionless) real(wp), parameter :: muon_g_factor = -2.0023318418_wp !> muon mag. mom. (J T^-1) real(wp), parameter :: muon_mag__mom_ = -4.49044830e-26_wp !> muon mag. mom. anomaly (dimensionless) real(wp), parameter :: muon_mag__mom__anomaly = 1.16592089e-3_wp !> muon mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: muon_mag__mom__to_Bohr_magneton_ratio = -4.84197047e-3_wp !> muon mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: muon_mag__mom__to_nuclear_magneton_ratio = -8.89059703_wp !> muon mass (kg) real(wp), parameter :: muon_mass = 1.883531627e-28_wp !> muon mass energy equivalent (J) real(wp), parameter :: muon_mass_energy_equivalent = 1.692833804e-11_wp !> muon mass energy equivalent in MeV (MeV) real(wp), parameter :: muon_mass_energy_equivalent_in_MeV = 105.6583755_wp !> muon mass in u (u) real(wp), parameter :: muon_mass_in_u = 0.1134289259_wp !> muon molar mass (kg mol^-1) real(wp), parameter :: muon_molar_mass = 1.134289259e-4_wp !> muon-neutron mass ratio (dimensionless) real(wp), parameter :: muon_neutron_mass_ratio = 0.1124545170_wp !> muon-proton mag. mom. ratio (dimensionless) real(wp), parameter :: muon_proton_mag__mom__ratio = -3.183345142_wp !> muon-proton mass ratio (dimensionless) real(wp), parameter :: muon_proton_mass_ratio = 0.1126095264_wp !> muon-tau mass ratio (dimensionless) real(wp), parameter :: muon_tau_mass_ratio = 5.94635e-2_wp !> natural unit of action (J s) real(wp), parameter :: natural_unit_of_action = 1.054571817e-34_wp !> natural unit of action in eV s (eV s) real(wp), parameter :: natural_unit_of_action_in_eV_s = 6.582119569e-16_wp !> natural unit of energy (J) real(wp), parameter :: natural_unit_of_energy = 8.1871057769e-14_wp !> natural unit of energy in MeV (MeV) real(wp), parameter :: natural_unit_of_energy_in_MeV = 0.51099895000_wp !> natural unit of length (m) real(wp), parameter :: natural_unit_of_length = 3.8615926796e-13_wp !> natural unit of mass (kg) real(wp), parameter :: natural_unit_of_mass = 9.1093837015e-31_wp !> natural unit of momentum (kg m s^-1) real(wp), parameter :: natural_unit_of_momentum = 2.73092453075e-22_wp !> natural unit of momentum in MeV/c (MeV/c) real(wp), parameter :: natural_unit_of_momentum_in_MeV_c = 0.51099895000_wp !> natural unit of time (s) real(wp), parameter :: natural_unit_of_time = 1.28808866819e-21_wp !> natural unit of velocity (m s^-1) real(wp), parameter :: natural_unit_of_velocity = 299792458e0_wp !> neutron Compton wavelength (m) real(wp), parameter :: neutron_Compton_wavelength = 1.31959090581e-15_wp !> neutron-electron mag. mom. ratio (dimensionless) real(wp), parameter :: neutron_electron_mag__mom__ratio = 1.04066882e-3_wp !> neutron-electron mass ratio (dimensionless) real(wp), parameter :: neutron_electron_mass_ratio = 1838.68366173_wp !> neutron g factor (dimensionless) real(wp), parameter :: neutron_g_factor = -3.82608545_wp !> neutron gyromag. ratio (s^-1 T^-1) real(wp), parameter :: neutron_gyromag__ratio = 1.83247171e8_wp !> neutron gyromag. ratio in MHz/T (MHz T^-1) real(wp), parameter :: neutron_gyromag__ratio_in_MHz_T = 29.1646931_wp !> neutron mag. mom. (J T^-1) real(wp), parameter :: neutron_mag__mom_ = -9.6623651e-27_wp !> neutron mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: neutron_mag__mom__to_Bohr_magneton_ratio = -1.04187563e-3_wp !> neutron mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: neutron_mag__mom__to_nuclear_magneton_ratio = -1.91304273_wp !> neutron mass (kg) real(wp), parameter :: neutron_mass = 1.67492749804e-27_wp !> neutron mass energy equivalent (J) real(wp), parameter :: neutron_mass_energy_equivalent = 1.50534976287e-10_wp !> neutron mass energy equivalent in MeV (MeV) real(wp), parameter :: neutron_mass_energy_equivalent_in_MeV = 939.56542052_wp !> neutron mass in u (u) real(wp), parameter :: neutron_mass_in_u = 1.00866491595_wp !> neutron molar mass (kg mol^-1) real(wp), parameter :: neutron_molar_mass = 1.00866491560e-3_wp !> neutron-muon mass ratio (dimensionless) real(wp), parameter :: neutron_muon_mass_ratio = 8.89248406_wp !> neutron-proton mag. mom. ratio (dimensionless) real(wp), parameter :: neutron_proton_mag__mom__ratio = -0.68497934_wp !> neutron-proton mass difference (kg) real(wp), parameter :: neutron_proton_mass_difference = 2.30557435e-30_wp !> neutron-proton mass difference energy equivalent (J) real(wp), parameter :: neutron_proton_mass_difference_energy_equivalent = 2.07214689e-13_wp !> neutron-proton mass difference energy equivalent in MeV (MeV) real(wp), parameter :: neutron_proton_mass_difference_energy_equivalent_in_MeV = 1.29333236_wp !> neutron-proton mass difference in u (u) real(wp), parameter :: neutron_proton_mass_difference_in_u = 1.38844933e-3_wp !> neutron-proton mass ratio (dimensionless) real(wp), parameter :: neutron_proton_mass_ratio = 1.00137841931_wp !> neutron relative atomic mass (dimensionless) real(wp), parameter :: neutron_relative_atomic_mass = 1.00866491595_wp !> neutron-tau mass ratio (dimensionless) real(wp), parameter :: neutron_tau_mass_ratio = 0.528779_wp !> neutron to shielded proton mag. mom. ratio (dimensionless) real(wp), parameter :: neutron_to_shielded_proton_mag__mom__ratio = -0.68499694_wp !> Newtonian constant of gravitation (m^3 kg^-1 s^-2) real(wp), parameter :: Newtonian_constant_of_gravitation = 6.67430e-11_wp !> Newtonian constant of gravitation over h-bar c ((GeV/c^2)^-2) real(wp), parameter :: Newtonian_constant_of_gravitation_over_h_bar_c = 6.70883e-39_wp !> nuclear magneton (J T^-1) real(wp), parameter :: nuclear_magneton = 5.0507837461e-27_wp !> nuclear magneton in eV/T (eV T^-1) real(wp), parameter :: nuclear_magneton_in_eV_T = 3.15245125844e-8_wp !> nuclear magneton in inverse meter per tesla (m^-1 T^-1) real(wp), parameter :: nuclear_magneton_in_inverse_meter_per_tesla = 2.54262341353e-2_wp !> nuclear magneton in K/T (K T^-1) real(wp), parameter :: nuclear_magneton_in_K_T = 3.6582677756e-4_wp !> nuclear magneton in MHz/T (MHz T^-1) real(wp), parameter :: nuclear_magneton_in_MHz_T = 7.6225932291_wp !> Planck constant (J Hz^-1) real(wp), parameter :: Planck_constant = 6.62607015e-34_wp !> Planck constant in eV/Hz (eV Hz^-1) real(wp), parameter :: Planck_constant_in_eV_Hz = 4.135667696e-15_wp !> Planck length (m) real(wp), parameter :: Planck_length = 1.616255e-35_wp !> Planck mass (kg) real(wp), parameter :: Planck_mass = 2.176434e-8_wp !> Planck mass energy equivalent in GeV (GeV) real(wp), parameter :: Planck_mass_energy_equivalent_in_GeV = 1.220890e19_wp !> Planck temperature (K) real(wp), parameter :: Planck_temperature = 1.416784e32_wp !> Planck time (s) real(wp), parameter :: Planck_time = 5.391247e-44_wp !> proton charge to mass quotient (C kg^-1) real(wp), parameter :: proton_charge_to_mass_quotient = 9.5788331560e7_wp !> proton Compton wavelength (m) real(wp), parameter :: proton_Compton_wavelength = 1.32140985539e-15_wp !> proton-electron mass ratio (dimensionless) real(wp), parameter :: proton_electron_mass_ratio = 1836.15267343_wp !> proton g factor (dimensionless) real(wp), parameter :: proton_g_factor = 5.5856946893_wp !> proton gyromag. ratio (s^-1 T^-1) real(wp), parameter :: proton_gyromag__ratio = 2.6752218744e8_wp !> proton gyromag. ratio in MHz/T (MHz T^-1) real(wp), parameter :: proton_gyromag__ratio_in_MHz_T = 42.577478518_wp !> proton mag. mom. (J T^-1) real(wp), parameter :: proton_mag__mom_ = 1.41060679736e-26_wp !> proton mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: proton_mag__mom__to_Bohr_magneton_ratio = 1.52103220230e-3_wp !> proton mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: proton_mag__mom__to_nuclear_magneton_ratio = 2.79284734463_wp !> proton mag. shielding correction (dimensionless) real(wp), parameter :: proton_mag__shielding_correction = 2.5689e-5_wp !> proton mass (kg) real(wp), parameter :: proton_mass = 1.67262192369e-27_wp !> proton mass energy equivalent (J) real(wp), parameter :: proton_mass_energy_equivalent = 1.50327761598e-10_wp !> proton mass energy equivalent in MeV (MeV) real(wp), parameter :: proton_mass_energy_equivalent_in_MeV = 938.27208816_wp !> proton mass in u (u) real(wp), parameter :: proton_mass_in_u = 1.007276466621_wp !> proton molar mass (kg mol^-1) real(wp), parameter :: proton_molar_mass = 1.00727646627e-3_wp !> proton-muon mass ratio (dimensionless) real(wp), parameter :: proton_muon_mass_ratio = 8.88024337_wp !> proton-neutron mag. mom. ratio (dimensionless) real(wp), parameter :: proton_neutron_mag__mom__ratio = -1.45989805_wp !> proton-neutron mass ratio (dimensionless) real(wp), parameter :: proton_neutron_mass_ratio = 0.99862347812_wp !> proton relative atomic mass (dimensionless) real(wp), parameter :: proton_relative_atomic_mass = 1.007276466621_wp !> proton rms charge radius (m) real(wp), parameter :: proton_rms_charge_radius = 8.414e-16_wp !> proton-tau mass ratio (dimensionless) real(wp), parameter :: proton_tau_mass_ratio = 0.528051_wp !> quantum of circulation (m^2 s^-1) real(wp), parameter :: quantum_of_circulation = 3.6369475516e-4_wp !> quantum of circulation times 2 (m^2 s^-1) real(wp), parameter :: quantum_of_circulation_times_2 = 7.2738951032e-4_wp !> reduced Compton wavelength (m) real(wp), parameter :: reduced_Compton_wavelength = 3.8615926796e-13_wp !> reduced muon Compton wavelength (m) real(wp), parameter :: reduced_muon_Compton_wavelength = 1.867594306e-15_wp !> reduced neutron Compton wavelength (m) real(wp), parameter :: reduced_neutron_Compton_wavelength = 2.1001941552e-16_wp !> reduced Planck constant (J s) real(wp), parameter :: reduced_Planck_constant = 1.054571817e-34_wp !> reduced Planck constant in eV s (eV s) real(wp), parameter :: reduced_Planck_constant_in_eV_s = 6.582119569e-16_wp !> reduced Planck constant times c in MeV fm (MeV fm) real(wp), parameter :: reduced_Planck_constant_times_c_in_MeV_fm = 197.3269804_wp !> reduced proton Compton wavelength (m) real(wp), parameter :: reduced_proton_Compton_wavelength = 2.10308910336e-16_wp !> reduced tau Compton wavelength (m) real(wp), parameter :: reduced_tau_Compton_wavelength = 1.110538e-16_wp !> Rydberg constant (m^-1) real(wp), parameter :: Rydberg_constant = 10973731.568160_wp !> Rydberg constant times c in Hz (Hz) real(wp), parameter :: Rydberg_constant_times_c_in_Hz = 3.2898419602508e15_wp !> Rydberg constant times hc in eV (eV) real(wp), parameter :: Rydberg_constant_times_hc_in_eV = 13.605693122994_wp !> Rydberg constant times hc in J (J) real(wp), parameter :: Rydberg_constant_times_hc_in_J = 2.1798723611035e-18_wp !> Sackur-Tetrode constant (1 K, 100 kPa) (dimensionless) real(wp), parameter :: Sackur_Tetrode_constant_1_K__100_kPa = -1.15170753706_wp !> Sackur-Tetrode constant (1 K, 101.325 kPa) (dimensionless) real(wp), parameter :: Sackur_Tetrode_constant_1_K__101_325_kPa = -1.16487052358_wp !> second radiation constant (m K) real(wp), parameter :: second_radiation_constant = 1.438776877e-2_wp !> shielded helion gyromag. ratio (s^-1 T^-1) real(wp), parameter :: shielded_helion_gyromag__ratio = 2.037894569e8_wp !> shielded helion gyromag. ratio in MHz/T (MHz T^-1) real(wp), parameter :: shielded_helion_gyromag__ratio_in_MHz_T = 32.43409942_wp !> shielded helion mag. mom. (J T^-1) real(wp), parameter :: shielded_helion_mag__mom_ = -1.074553090e-26_wp !> shielded helion mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: shielded_helion_mag__mom__to_Bohr_magneton_ratio = -1.158671471e-3_wp !> shielded helion mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: shielded_helion_mag__mom__to_nuclear_magneton_ratio = -2.127497719_wp !> shielded helion to proton mag. mom. ratio (dimensionless) real(wp), parameter :: shielded_helion_to_proton_mag__mom__ratio = -0.7617665618_wp !> shielded helion to shielded proton mag. mom. ratio (dimensionless) real(wp), parameter :: shielded_helion_to_shielded_proton_mag__mom__ratio = -0.7617861313_wp !> shielded proton gyromag. ratio (s^-1 T^-1) real(wp), parameter :: shielded_proton_gyromag__ratio = 2.675153151e8_wp !> shielded proton gyromag. ratio in MHz/T (MHz T^-1) real(wp), parameter :: shielded_proton_gyromag__ratio_in_MHz_T = 42.57638474_wp !> shielded proton mag. mom. (J T^-1) real(wp), parameter :: shielded_proton_mag__mom_ = 1.410570560e-26_wp !> shielded proton mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: shielded_proton_mag__mom__to_Bohr_magneton_ratio = 1.520993128e-3_wp !> shielded proton mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: shielded_proton_mag__mom__to_nuclear_magneton_ratio = 2.792775599_wp !> shielding difference of d and p in HD (dimensionless) real(wp), parameter :: shielding_difference_of_d_and_p_in_HD = 2.0200e-8_wp !> shielding difference of t and p in HT (dimensionless) real(wp), parameter :: shielding_difference_of_t_and_p_in_HT = 2.4140e-8_wp !> speed of light in vacuum (m s^-1) real(wp), parameter :: speed_of_light_in_vacuum = 299792458e0_wp !> standard acceleration of gravity (m s^-2) real(wp), parameter :: standard_acceleration_of_gravity = 9.80665_wp !> standard atmosphere (Pa) real(wp), parameter :: standard_atmosphere = 101325e0_wp !> standard-state pressure (Pa) real(wp), parameter :: standard_state_pressure = 100000e0_wp !> Stefan-Boltzmann constant (W m^-2 K^-4) real(wp), parameter :: Stefan_Boltzmann_constant = 5.670374419e-8_wp !> tau Compton wavelength (m) real(wp), parameter :: tau_Compton_wavelength = 6.97771e-16_wp !> tau-electron mass ratio (dimensionless) real(wp), parameter :: tau_electron_mass_ratio = 3477.23_wp !> tau energy equivalent (MeV) real(wp), parameter :: tau_energy_equivalent = 1776.86_wp !> tau mass (kg) real(wp), parameter :: tau_mass = 3.16754e-27_wp !> tau mass energy equivalent (J) real(wp), parameter :: tau_mass_energy_equivalent = 2.84684e-10_wp !> tau mass in u (u) real(wp), parameter :: tau_mass_in_u = 1.90754_wp !> tau molar mass (kg mol^-1) real(wp), parameter :: tau_molar_mass = 1.90754e-3_wp !> tau-muon mass ratio (dimensionless) real(wp), parameter :: tau_muon_mass_ratio = 16.8170_wp !> tau-neutron mass ratio (dimensionless) real(wp), parameter :: tau_neutron_mass_ratio = 1.89115_wp !> tau-proton mass ratio (dimensionless) real(wp), parameter :: tau_proton_mass_ratio = 1.89376_wp !> Thomson cross section (m^2) real(wp), parameter :: Thomson_cross_section = 6.6524587321e-29_wp !> triton-electron mass ratio (dimensionless) real(wp), parameter :: triton_electron_mass_ratio = 5496.92153573_wp !> triton g factor (dimensionless) real(wp), parameter :: triton_g_factor = 5.957924931_wp !> triton mag. mom. (J T^-1) real(wp), parameter :: triton_mag__mom_ = 1.5046095202e-26_wp !> triton mag. mom. to Bohr magneton ratio (dimensionless) real(wp), parameter :: triton_mag__mom__to_Bohr_magneton_ratio = 1.6223936651e-3_wp !> triton mag. mom. to nuclear magneton ratio (dimensionless) real(wp), parameter :: triton_mag__mom__to_nuclear_magneton_ratio = 2.9789624656_wp !> triton mass (kg) real(wp), parameter :: triton_mass = 5.0073567446e-27_wp !> triton mass energy equivalent (J) real(wp), parameter :: triton_mass_energy_equivalent = 4.5003878060e-10_wp !> triton mass energy equivalent in MeV (MeV) real(wp), parameter :: triton_mass_energy_equivalent_in_MeV = 2808.92113298_wp !> triton mass in u (u) real(wp), parameter :: triton_mass_in_u = 3.01550071621_wp !> triton molar mass (kg mol^-1) real(wp), parameter :: triton_molar_mass = 3.01550071517e-3_wp !> triton-proton mass ratio (dimensionless) real(wp), parameter :: triton_proton_mass_ratio = 2.99371703414_wp !> triton relative atomic mass (dimensionless) real(wp), parameter :: triton_relative_atomic_mass = 3.01550071621_wp !> triton to proton mag. mom. ratio (dimensionless) real(wp), parameter :: triton_to_proton_mag__mom__ratio = 1.0666399191_wp !> unified atomic mass unit (kg) real(wp), parameter :: unified_atomic_mass_unit = 1.66053906660e-27_wp !> vacuum electric permittivity (F m^-1) real(wp), parameter :: vacuum_electric_permittivity = 8.8541878128e-12_wp !> vacuum mag. permeability (N A^-2) real(wp), parameter :: vacuum_mag__permeability = 1.25663706212e-6_wp !> von Klitzing constant (ohm) real(wp), parameter :: von_Klitzing_constant = 25812.80745_wp !> weak mixing angle (dimensionless) real(wp), parameter :: weak_mixing_angle = 0.22290_wp !> Wien frequency displacement law constant (Hz K^-1) real(wp), parameter :: Wien_frequency_displacement_law_constant = 5.878925757e10_wp !> Wien wavelength displacement law constant (m K) real(wp), parameter :: Wien_wavelength_displacement_law_constant = 2.897771955e-3_wp !> W to Z mass ratio (dimensionless) real(wp), parameter :: W_to_Z_mass_ratio = 0.88153_wp end module mctc_io_codata2018 mctc-lib-0.3.2/src/mctc/io/constants.f90000066400000000000000000000034071466406626700177130ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Numerical constants module mctc_io_constants use mctc_env_accuracy, only : wp use mctc_io_codata2018, only : planck_constant, speed_of_light_in_vacuum, & & boltzmann_constant, avogadro_constant, elementary_charge, fine_structure_constant, & & electron_mass implicit none private public :: pi, codata !> Ratio between a circles diameter and its circumfence real(wp), parameter :: pi = 3.1415926535897932384626433832795029_wp !> Natural constants defining the SI unit base type :: enum_codata !> Planck's constant real(wp) :: h = planck_constant !> Speed of light in vacuum real(wp) :: c = speed_of_light_in_vacuum !> Boltzmann's constant real(wp) :: kb = boltzmann_constant !> Avogadro's number real(wp) :: NA = avogadro_constant !> Elementary charge real(wp) :: e = elementary_charge !> fine structure constant (CODATA2018) real(wp) :: alpha = fine_structure_constant !> electron rest mass real(wp) :: me = electron_mass end type enum_codata !> Actual collection of natural constants type(enum_codata), parameter :: codata = enum_codata() end module mctc_io_constants mctc-lib-0.3.2/src/mctc/io/convert.f90000066400000000000000000000067031466406626700173610ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Conversion factors module mctc_io_convert use mctc_env_accuracy, only : wp use mctc_io_constants, only : pi, codata implicit none private !> Reduced Planck's constant real(wp), parameter :: hbar = codata%h/(2.0_wp*pi) ! J·s = kg·m²·s⁻¹ !> Bohr radius real(wp), parameter :: bohr = hbar/(codata%me*codata%c*codata%alpha) ! m !> Hartree energy real(wp), parameter :: hartree = codata%me*codata%c**2*codata%alpha**2 ! J = kg·m²·s⁻² !> Conversion factor from bohr to Ångström real(wp), public, parameter :: autoaa = bohr * 1e10_wp !> Conversion factor from Ångström to bohr real(wp), public, parameter :: aatoau = 1.0_wp/autoaa !> Conversion factor from hartree to electron volts real(wp), public, parameter :: autoeV = hartree/codata%e !> Conversion factor from electron volts to hartree real(wp), public, parameter :: evtoau = 1.0_wp/autoev !> Conversion factor between calorie and joule real(wp), public, parameter :: caltoj = 4.184_wp !> Conversion factor between joule and calorie real(wp), public, parameter :: jtocal = 1.0_wp/caltoj !> Conversion from hartree to kJ/mol real(wp), public, parameter :: autokj = hartree*codata%na*1e-3_wp !> Conversion from kJ/mol to hartree real(wp), public, parameter :: kjtoau = 1.0_wp/autokj !> Conversion from hartree to kcal/mol real(wp), public, parameter :: autokcal = autokJ*Jtocal !> Conversion from kcal/mol to hartree real(wp), public, parameter :: kcaltoau = 1.0_wp/autokcal !> Conversion from hartree to reciprocal centimeters real(wp), public, parameter :: autorcm = hartree/(codata%h*codata%c)*1e-2_wp !> Conversion from reciprocal centimeters to hartree real(wp), public, parameter :: rcmtoau = 1.0_wp/autorcm !> Conversion from hartree to nanometers (wavelength) real(wp), public, parameter :: autonm = codata%h*codata%c/hartree * 1e+9_wp !> Conversion from nanometers (wavelength) to hartree real(wp), public, parameter :: nmtoau = 1.0_wp/autonm !> Conversion from electron mass (a.u.) to kg real(wp), public, parameter :: autokg = codata%me !> Conversion from kg to electron mass (a.u.) real(wp), public, parameter :: kgtoau = 1.0_wp/autokg !> Molecular mass per mole (g/mol) to electron mass (a.u.) real(wp), public, parameter :: autogmol = codata%me*codata%na*1e+3_wp !> Electron mass (a.u.) to molecular mass per mole (g/mol) real(wp), public, parameter :: gmoltoau = 1.0_wp/autogmol !> Molecular mass per mole (g/mol) to kg real(wp), public, parameter :: gmoltokg = gmoltoau*autokg !> kg to molecular mass per mole (g/mol) real(wp), public, parameter :: kgtogmol = 1.0_wp/gmoltokg !> Coulomb to atomic charge units real(wp), public, parameter :: autoc = codata%e !> Atomic charge units to Coulomb real(wp), public, parameter :: ctoau = 1.0_wp/autoc end module mctc_io_convert mctc-lib-0.3.2/src/mctc/io/filetype.f90000066400000000000000000000076331466406626700175250ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> File type support module mctc_io_filetype implicit none private public :: filetype, get_filetype !> Possible file types type :: enum_filetype !> Unknown file type integer :: unknown = 0 !> xyz-format integer :: xyz = 1 !> Turbomole coordinate format integer :: tmol = 2 !> mol-format integer :: molfile = 3 !> Vasp coordinate input integer :: vasp = 4 !> Protein database format integer :: pdb = 5 !> Structure data format integer :: sdf = 6 !> GenFormat of DFTB+ integer :: gen = 7 !> Gaussian external format integer :: gaussian = 8 !> QCSchema JSON file integer :: qcschema = 9 !> FHI-aims geometry.in format integer :: aims = 10 !> Q-Chem molecule format integer :: qchem = 11 !> Chemical JSON format (avogadro) integer :: cjson = 12 end type enum_filetype !> File type enumerator type(enum_filetype), parameter :: filetype = enum_filetype() contains elemental function get_filetype(file) result(ftype) !> Name of the file character(len=*), intent(in) :: file !> File type from extension integer :: ftype integer :: iext, isep ftype = filetype%unknown iext = index(file, '.', back=.true.) isep = scan(file, '\/', back=.true.) if (iext > isep .and. iext > 0) then select case(to_lower(file(iext+1:))) case('coord', 'tmol') ftype = filetype%tmol case('xyz', 'log') ftype = filetype%xyz case('mol') ftype = filetype%molfile case('sdf') ftype = filetype%sdf case('poscar', 'contcar', 'vasp') ftype = filetype%vasp case('pdb') ftype = filetype%pdb case('gen') ftype = filetype%gen case('ein') ftype = filetype%gaussian case('json') ftype = filetype%qcschema case('cjson') ftype = filetype%cjson case('qchem') ftype = filetype%qchem end select if (ftype /= filetype%unknown) return else iext = len(file) + 1 end if if (iext > isep) then if (file(isep+1:) == 'geometry.in') then ftype = filetype%aims end if select case(to_lower(file(isep+1:iext-1))) case('geometry.in') ftype = filetype%aims case('coord') ftype = filetype%tmol case('poscar', 'contcar') ftype = filetype%vasp end select end if end function get_filetype !> Convert input string to lowercase elemental function to_lower(str) result(lcstr) !> Input string character(len=*), intent(in) :: str !> Lowercase version of string character(len=len(str)):: lcstr integer :: ilen, iquote, i, iav, iqc integer, parameter :: offset = iachar('A') - iachar('a') ilen = len(str) iquote = 0 lcstr = str do i = 1, ilen iav = iachar(str(i:i)) if (iquote == 0 .and. (iav == 34 .or.iav == 39)) then iquote = 1 iqc = iav cycle end if if (iquote == 1 .and. iav==iqc) then iquote=0 cycle end if if (iquote == 1) cycle if (iav >= iachar('A') .and. iav <= iachar('Z')) then lcstr(i:i) = achar(iav - offset) else lcstr(i:i) = str(i:i) end if end do end function to_lower end module mctc_io_filetype mctc-lib-0.3.2/src/mctc/io/math.f90000066400000000000000000000212421466406626700166250ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Simple algebraic functions module mctc_io_math use mctc_env_accuracy, only : wp use mctc_io_constants, only : pi implicit none private public :: matdet_3x3, matinv_3x3, crossprod, eigval_3x3, eigvec_3x3 real(wp), parameter :: twothirdpi = 2.0_wp * pi / 3.0_wp contains !> Performs a direct calculation of the inverse of a 3×3 matrix. ! ! reference: http://fortranwiki.org/fortran/show/Matrix+inversion pure function matinv_3x3(a) result(b) !> Matrix real(wp), intent(in) :: a(3, 3) !> Inverse matrix real(wp) :: b(3, 3) real(wp) :: detinv ! Calculate the inverse determinant of the matrix detinv = 1.0_wp/matdet_3x3(a) ! Calculate the inverse of the matrix b(1, 1) = +detinv * (a(2, 2) * a(3, 3) - a(2, 3) * a(3, 2)) b(2, 1) = -detinv * (a(2, 1) * a(3, 3) - a(2, 3) * a(3, 1)) b(3, 1) = +detinv * (a(2, 1) * a(3, 2) - a(2, 2) * a(3, 1)) b(1, 2) = -detinv * (a(1, 2) * a(3, 3) - a(1, 3) * a(3, 2)) b(2, 2) = +detinv * (a(1, 1) * a(3, 3) - a(1, 3) * a(3, 1)) b(3, 2) = -detinv * (a(1, 1) * a(3, 2) - a(1, 2) * a(3, 1)) b(1, 3) = +detinv * (a(1, 2) * a(2, 3) - a(1, 3) * a(2, 2)) b(2, 3) = -detinv * (a(1, 1) * a(2, 3) - a(1, 3) * a(2, 1)) b(3, 3) = +detinv * (a(1, 1) * a(2, 2) - a(1, 2) * a(2, 1)) end function matinv_3x3 !> Determinant of 3×3 matrix pure function matdet_3x3(a) result (det) !> Matrix real(wp), intent(in) :: a(3, 3) !> Determinant real(wp) :: det det = a(1, 1) * a(2, 2) * a(3, 3) & & - a(1, 1) * a(2, 3) * a(3, 2) & & - a(1, 2) * a(2, 1) * a(3, 3) & & + a(1, 2) * a(2, 3) * a(3, 1) & & + a(1, 3) * a(2, 1) * a(3, 2) & & - a(1, 3) * a(2, 2) * a(3, 1) end function matdet_3x3 !> Implements the cross/vector product between two 3D vectors pure function crossprod(a,b) result(c) !> First vector real(wp), intent(in) :: a(3) !> Second vector real(wp), intent(in) :: b(3) !> Orthogonal vector real(wp) :: c(3) c(1) = a(2) * b(3) - b(2) * a(3) c(2) = a(3) * b(1) - b(3) * a(1) c(3) = a(1) * b(2) - b(1) * a(2) end function crossprod !> Calculates eigenvalues based on the trigonometric solution of A = pB + qI pure subroutine eigval_3x3(a, w) !> The symmetric input matrix real(wp), intent(in) :: a(3, 3) !> Contains eigenvalues on exit real(wp), intent(out) :: w(3) real(wp) :: q, p, r r = a(1, 2) * a(1, 2) + a(1, 3) * a(1, 3) + a(2, 3) * a(2, 3) q = (a(1, 1) + a(2, 2) + a(3, 3)) / 3.0_wp w(1) = a(1, 1) - q w(2) = a(2, 2) - q w(3) = a(3, 3) - q p = sqrt((w(1) * w(1) + w(2) * w(2) + w(3) * w(3) + 2*r) / 6.0_wp) r = (w(1) * (w(2) * w(3) - a(2, 3) * a(2, 3)) & & - a(1, 2) * (a(1, 2) * w(3) - a(2, 3) * a(1, 3)) & & + a(1, 3) * (a(1, 2) * a(2, 3) - w(2) * a(1, 3))) / (p*p*p) * 0.5_wp if (r <= -1.0_wp) then r = 0.5_wp * twothirdpi else if (r >= 1.0_wp) then r = 0.0_wp else r = acos(r) / 3.0_wp end if w(3) = q + 2 * p * cos(r) w(1) = q + 2 * p * cos(r + twothirdpi) w(2) = 3 * q - w(1) - w(3) end subroutine eigval_3x3 !> Calculates eigenvector using an analytical method based on vector cross ! products. pure subroutine eigvec_3x3(a, w, q) real(wp), intent(inout) :: a(3,3) real(wp), intent(out) :: w(3) real(wp), intent(out) :: q(3,3) real(wp), parameter :: eps = epsilon(1.0_wp) real(wp) norm, n1, n2, n3, precon integer :: i w(1) = max(abs(a(1, 1)), abs(a(1, 2))) w(2) = max(abs(a(1, 3)), abs(a(2, 2))) w(3) = max(abs(a(2, 3)), abs(a(3, 3))) precon = max(w(1), max(w(2), w(3))) ! null matrix if (precon < eps) then w(1) = 0.0_wp w(2) = 0.0_wp w(3) = 0.0_wp q(1, 1) = 1.0_wp q(2, 2) = 1.0_wp q(3, 3) = 1.0_wp q(1, 2) = 0.0_wp q(1, 3) = 0.0_wp q(2, 3) = 0.0_wp q(2, 1) = 0.0_wp q(3, 1) = 0.0_wp q(3, 2) = 0.0_wp return end if norm = 1.0_wp / precon a(1, 1) = a(1, 1) * norm a(1, 2) = a(1, 2) * norm a(2, 2) = a(2, 2) * norm a(1, 3) = a(1, 3) * norm a(2, 3) = a(2, 3) * norm a(3, 3) = a(3, 3) * norm ! Calculate eigenvalues call eigval_3x3(a, w) ! Compute first eigenvector a(1, 1) = a(1, 1) - w(1) a(2, 2) = a(2, 2) - w(1) a(3, 3) = a(3, 3) - w(1) q(1, 1) = a(1, 2) * a(2, 3) - a(1, 3) * a(2, 2) q(2, 1) = a(1, 3) * a(1, 2) - a(1, 1) * a(2, 3) q(3, 1) = a(1, 1) * a(2, 2) - a(1, 2) * a(1, 2) q(1, 2) = a(1, 2) * a(3, 3) - a(1, 3) * a(2, 3) q(2, 2) = a(1, 3) * a(1, 3) - a(1, 1) * a(3, 3) q(3, 2) = a(1, 1) * a(2, 3) - a(1, 2) * a(1, 3) q(1, 3) = a(2, 2) * a(3, 3) - a(2, 3) * a(2, 3) q(2, 3) = a(2, 3) * a(1, 3) - a(1, 2) * a(3, 3) q(3, 3) = a(1, 2) * a(2, 3) - a(2, 2) * a(1, 3) n1 = q(1, 1) * q(1, 1) + q(2, 1) * q(2, 1) + q(3, 1) * q(3, 1) n2 = q(1, 2) * q(1, 2) + q(2, 2) * q(2, 2) + q(3, 2) * q(3, 2) n3 = q(1, 3) * q(1, 3) + q(2, 3) * q(2, 3) + q(3, 3) * q(3, 3) norm = n1 i = 1 if (n2 > norm) then i = 2 norm = n1 end if if (n3 > norm) then i = 3 end if if (i == 1) then norm = sqrt(1.0_wp / n1) q(1, 1) = q(1, 1) * norm q(2, 1) = q(2, 1) * norm q(3, 1) = q(3, 1) * norm else if (i == 2) then norm = sqrt(1.0_wp / n2) q(1, 1) = q(1, 2) * norm q(2, 1) = q(2, 2) * norm q(3, 1) = q(3, 2) * norm else norm = sqrt(1.0_wp / n3) q(1, 1) = q(1, 3) * norm q(2, 1) = q(2, 3) * norm q(3, 1) = q(3, 3) * norm end if ! Robustly compute a right-hand orthonormal set (ev1, u, v) if (abs(q(1, 1)) > abs(q(2, 1))) then norm = sqrt(1.0_wp / (q(1, 1) * q(1, 1) + q(3, 1) * q(3, 1))) q(1, 2) = -q(3, 1) * norm q(2, 2) = 0.0_wp q(3, 2) = +q(1, 1) * norm else norm = sqrt(1.0_wp / (q(2, 1) * q(2, 1) + q(3, 1) * q(3, 1))) q(1, 2) = 0.0_wp q(2, 2) = +q(3, 1) * norm q(3, 2) = -q(2, 1) * norm end if q(1, 3) = q(2, 1) * q(3, 2) - q(3, 1) * q(2, 2) q(2, 3) = q(3, 1) * q(1, 2) - q(1, 1) * q(3, 2) q(3, 3) = q(1, 1) * q(2, 2) - q(2, 1) * q(1, 2) ! Reset A a(1, 1) = a(1, 1) + w(1) a(2, 2) = a(2, 2) + w(1) a(3, 3) = a(3, 3) + w(1) ! A*U n1 = a(1, 1) * q(1, 2) + a(1, 2) * q(2, 2) + a(1, 3) * q(3, 2) n2 = a(1, 2) * q(1, 2) + a(2, 2) * q(2, 2) + a(2, 3) * q(3, 2) n3 = a(1, 3) * q(1, 2) + a(2, 3) * q(2, 2) + a(3, 3) * q(3, 2) ! A*V, note out of order computation a(3, 3) = a(1, 3) * q(1, 3) + a(2, 3) * q(2, 3) + a(3, 3) * q(3, 3) a(1, 3) = a(1, 1) * q(1, 3) + a(1, 2) * q(2, 3) + a(1, 3) * q(3, 3) a(2, 3) = a(1, 2) * q(1, 3) + a(2, 2) * q(2, 3) + a(2, 3) * q(3, 3) ! UT*(A*U) - l2*E n1 = q(1, 2) * n1 + q(2, 2) * n2 + q(3, 2) * n3 - w(2) ! UT*(A*V) n2 = q(1, 2) * a(1, 3) + q(2, 2) * a(2, 3) + q(3, 2) * a(3, 3) ! VT*(A*V) - l2*E n3 = q(1, 3) * a(1, 3) + q(2, 3) * a(2, 3) + q(3, 3) * a(3, 3) - w(2) if (abs(n1) >= abs(n3)) then norm = max(abs(n1), abs(n2)) if (norm > eps) then if (abs(n1) >= abs(n2)) then n2 = n2 / n1 n1 = sqrt(1.0_wp / (1.0_wp + n2 * n2)) n2 = n2 * n1 else n1 = n1 / n2 n2 = sqrt(1.0_wp / (1.0_wp + n1 * n1)) n1 = n1 * n2 end if q(1, 2) = n2 * q(1, 2) - n1 * q(1, 3) q(2, 2) = n2 * q(2, 2) - n1 * q(2, 3) q(3, 2) = n2 * q(3, 2) - n1 * q(3, 3) end if else norm = max(abs(n3), abs(n2)) if (norm > eps) then if (abs(n3) >= abs(n2)) then n2 = n2 / n3 n3 = sqrt(1.0_wp / (1.0_wp + n2 * n2)) n2 = n2 * n3 else n3 = n3 / n2 n2 = sqrt(1.0_wp / (1.0_wp + n3 * n3)) n3 = n3 * n2 end if q(1, 2) = n3 * q(1, 2) - n2 * q(1, 3) q(2, 2) = n3 * q(2, 2) - n2 * q(2, 3) q(3, 2) = n3 * q(3, 2) - n2 * q(3, 3) end if end if ! Calculate third eigenvector from cross product q(1, 3) = q(2, 1) * q(3, 2) - q(3, 1) * q(2, 2) q(2, 3) = q(3, 1) * q(1, 2) - q(1, 1) * q(3, 2) q(3, 3) = q(1, 1) * q(2, 2) - q(2, 1) * q(1, 2) w(1) = w(1) * precon w(2) = w(2) * precon w(3) = w(3) * precon end subroutine eigvec_3x3 end module mctc_io_math mctc-lib-0.3.2/src/mctc/io/meson.build000066400000000000000000000015011466406626700175120ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. subdir('read') subdir('structure') subdir('write') srcs += files( 'codata2018.f90', 'constants.f90', 'convert.f90', 'filetype.f90', 'math.f90', 'read.f90', 'resize.f90', 'structure.f90', 'symbols.f90', 'utils.f90', 'write.f90', ) mctc-lib-0.3.2/src/mctc/io/read.f90000066400000000000000000000111331466406626700166050ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read use mctc_env_error, only : error_type, fatal_error use mctc_io_filetype, only : filetype, get_filetype use mctc_io_read_aims, only : read_aims use mctc_io_read_cjson, only : read_cjson use mctc_io_read_ctfile, only : read_molfile, read_sdf use mctc_io_read_gaussian, only : read_gaussian_external use mctc_io_read_genformat, only : read_genformat use mctc_io_read_qchem, only : read_qchem use mctc_io_read_qcschema, only : read_qcschema use mctc_io_read_pdb, only : read_pdb use mctc_io_read_turbomole, only : read_coord use mctc_io_read_vasp, only : read_vasp use mctc_io_read_xyz, only : read_xyz use mctc_io_structure, only : structure_type, new_structure implicit none private public :: read_structure public :: structure_reader, get_structure_reader interface read_structure module procedure :: read_structure_from_file module procedure :: read_structure_from_unit end interface read_structure abstract interface !> Read molecular structure data from formatted unit subroutine structure_reader(self, unit, error) import :: structure_type, error_type !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error end subroutine structure_reader end interface contains subroutine read_structure_from_file(self, file, error, format) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> Name of the file to read character(len=*), intent(in) :: file !> Error handling type(error_type), allocatable, intent(out) :: error !> File type format hint integer, intent(in), optional :: format logical :: exist integer :: unit, stat, ftype inquire(file=file, exist=exist) if (.not.exist) then call fatal_error(error, "File '"//file//"' cannot be found") return end if open(file=file, newunit=unit, status='old', iostat=stat) if (stat /= 0) then call fatal_error(error, "Cannot open '"//file//"'") return end if if (present(format)) then ftype = format else ftype = get_filetype(file) end if call read_structure(self, unit, ftype, error) close(unit) end subroutine read_structure_from_file subroutine read_structure_from_unit(self, unit, ftype, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> File type to read integer, intent(in) :: ftype !> Error handling type(error_type), allocatable, intent(out) :: error procedure(structure_reader), pointer :: reader call get_structure_reader(reader, ftype) if (.not.associated(reader)) then call fatal_error(error, "Cannot read structure from unknown file format") return end if call reader(self, unit, error) end subroutine read_structure_from_unit !> Retrieve reader for corresponding file type subroutine get_structure_reader(reader, ftype) !> Reader for the specified file type procedure(structure_reader), pointer, intent(out) :: reader !> File type to read integer, intent(in) :: ftype nullify(reader) select case(ftype) case(filetype%xyz) reader => read_xyz case(filetype%molfile) reader => read_molfile case(filetype%qcschema) reader => read_qcschema case(filetype%cjson) reader => read_cjson case(filetype%pdb) reader => read_pdb case(filetype%gen) reader => read_genformat case(filetype%sdf) reader => read_sdf case(filetype%vasp) reader => read_vasp case(filetype%tmol) reader => read_coord case(filetype%gaussian) reader => read_gaussian_external case(filetype%aims) reader => read_aims case(filetype%qchem) reader => read_qchem end select end subroutine get_structure_reader end module mctc_io_read mctc-lib-0.3.2/src/mctc/io/read/000077500000000000000000000000001466406626700162665ustar00rootroot00000000000000mctc-lib-0.3.2/src/mctc/io/read/CMakeLists.txt000066400000000000000000000016241466406626700210310ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. set(dir "${CMAKE_CURRENT_SOURCE_DIR}") list( APPEND srcs "${dir}/aims.f90" "${dir}/cjson.F90" "${dir}/ctfile.f90" "${dir}/gaussian.f90" "${dir}/genformat.f90" "${dir}/qchem.f90" "${dir}/qcschema.F90" "${dir}/pdb.f90" "${dir}/turbomole.f90" "${dir}/vasp.f90" "${dir}/xyz.f90" ) set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/io/read/aims.f90000066400000000000000000000121441466406626700175410ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_aims use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_convert, only : aatoau use mctc_io_resize, only : resize use mctc_io_symbols, only : symbol_length, to_number use mctc_io_structure, only : structure_type, new use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_next_token, to_string implicit none private public :: read_aims integer, parameter :: initial_size = 64 contains subroutine read_aims(mol, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: mol !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error integer :: stat, pos, lnum, ilt, iat type(token_type) :: token character(len=:), allocatable :: line real(wp) :: x, y, z character(len=symbol_length), allocatable :: sym(:) real(wp), allocatable :: xyz(:, :), abc(:, :), lattice(:, :) logical :: is_frac, periodic(3) logical, allocatable :: frac(:) allocate(sym(initial_size), source=repeat(' ', symbol_length)) allocate(xyz(3, initial_size), source=0.0_wp) allocate(abc(3, initial_size), source=0.0_wp) allocate(frac(initial_size), source=.false.) iat = 0 ilt = 0 periodic(:) = .false. lnum = 0 stat = 0 do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (stat /= 0) exit if (len(line) == 0) cycle if (line(1:1) == "#") cycle call next_token(line, pos, token) select case(line(token%first:token%last)) case("atom", "atom_frac") is_frac = token%last - token%first + 1 > 4 call read_next_token(line, pos, token, x, stat) if (stat == 0) & call read_next_token(line, pos, token, y, stat) if (stat == 0) & call read_next_token(line, pos, token, z, stat) if (stat == 0) & call next_token(line, pos, token) if (stat /= 0) then call io_error(error, "Cannot read coordinates", & & line, token, filename(unit), lnum, "expected real value") exit end if if (iat >= size(sym)) call resize(sym) if (iat >= size(xyz, 2)) call resize(xyz) if (iat >= size(abc, 2)) call resize(abc) if (iat >= size(frac)) call resize(frac) iat = iat + 1 token%last = min(token%last, token%first + symbol_length - 1) sym(iat) = line(token%first:token%last) if (to_number(sym(iat)) == 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, token, filename(unit), lnum, "unknown element") exit end if frac(iat) = is_frac if (frac(iat)) then abc(:, iat) = [x, y, z] xyz(:, iat) = 0.0_wp else abc(:, iat) = 0.0_wp xyz(:, iat) = [x, y, z] * aatoau end if case("lattice_vector") ilt = ilt + 1 if (ilt > 3) then call io_error(error, "Too many lattice vectors", & & line, token, filename(unit), lnum, "forth lattice vector found") exit end if call read_next_token(line, pos, token, x, stat) if (stat == 0) & call read_next_token(line, pos, token, y, stat) if (stat == 0) & call read_next_token(line, pos, token, z, stat) if (stat /= 0) then call io_error(error, "Cannot read lattice vectors", & & line, token, filename(unit), lnum, "expected real value") exit end if if (.not.allocated(lattice)) allocate(lattice(3, 3), source=0.0_wp) lattice(:, ilt) = [x, y, z] * aatoau case default call io_error(error, "Unexpected keyword found", & & line, token, filename(unit), lnum, "invalid in this context") exit end select end do if (allocated(error)) return if (iat == 0) then token = token_type(0, 0) call io_error(error, "No atoms found", & & line, token, filename(unit), lnum+1, "expected atom specification") return end if if (allocated(lattice)) then xyz(ilt+1:3, :iat) = xyz(ilt+1:3, :iat) + abc(ilt+1:3, :iat) * aatoau xyz(:ilt, :iat) = xyz(:ilt, :iat) + matmul(lattice(:ilt, :ilt), abc(:ilt, :iat)) periodic(:ilt) = .true. end if call new(mol, sym(:iat), xyz, lattice=lattice, periodic=periodic) end subroutine read_aims end module mctc_io_read_aims mctc-lib-0.3.2/src/mctc/io/read/cjson.F90000066400000000000000000000175531466406626700176750ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. #include "mctc/defs.h" module mctc_io_read_cjson use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_constants, only : pi use mctc_io_convert, only : aatoau use mctc_io_structure, only : structure_type, new use mctc_io_symbols, only : to_number, symbol_length use mctc_io_utils, only : getline #if WITH_JSON use json_value_module, only : json_core, json_value #endif implicit none private public :: read_cjson contains subroutine read_cjson(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error #if WITH_JSON type(json_core) :: json type(json_value), pointer :: root, val, child, array logical :: cartesian, found integer :: stat, schema_version, charge, multiplicity, ibond character(len=:), allocatable :: input, line, message, comment integer, allocatable :: num(:), bond(:, :), list(:), order(:) real(wp) :: cellpar(6) real(wp), allocatable :: lattice(:, :) real(wp), allocatable, target :: geo(:) real(wp), pointer :: xyz(:, :) stat = 0 input = "" do call getline(unit, line, stat) if (stat /= 0) exit input = input // line end do call json%deserialize(root, input) if (json%failed()) then call json%check_for_errors(error_msg=message) call fatal_error(error, message) call json%destroy(root) return end if val => root call cjson_get(json, val, "chemicalJson", "chemical json", child) if (.not.associated(child)) then call fatal_error(error, "No 'chemical json' key found") call json%destroy(root) return end if call json%get(child, schema_version) ! There seems to be no actual difference between version 0 and 1, though if (all(schema_version /= [0, 1])) then call fatal_error(error, "Unsupported schema version for 'chemical json'") call json%destroy(root) return end if call json%get(val, "atoms.elements.number", num) if (.not.allocated(num) .or. json%failed()) then call fatal_error(error, "List of atomic symbols must be provided") call json%destroy(root) return end if call cjson_get(json, val, "unitCell", "unit cell", child) if (associated(child)) then call json%get(child, "a", cellpar(1)) call json%get(child, "b", cellpar(2)) call json%get(child, "c", cellpar(3)) call json%get(child, "alpha", cellpar(4)) call json%get(child, "beta", cellpar(5)) call json%get(child, "gamma", cellpar(6)) if (json%failed()) then call json%check_for_errors(error_msg=message) call fatal_error(error, message) call json%destroy(root) return end if cellpar(1:3) = cellpar(1:3) * aatoau cellpar(4:6) = cellpar(4:6) * (pi / 180) allocate(lattice(3, 3)) call cell_to_dlat(cellpar, lattice) end if call json%get(val, "atoms.coords.3d", geo, found=cartesian) if (.not.cartesian .and. allocated(lattice)) then call cjson_get(json, val, "atoms.coords.3dFractional", "atoms.coords.3d fractional", & & child) if (associated(child)) call json%get(child, geo) end if if (.not.allocated(geo) .or. json%failed()) then call fatal_error(error, "Cartesian coordinates must be provided") call json%destroy(root) return end if if (3*size(num) /= size(geo)) then call fatal_error(error, "Number of atomic numbers and coordinate triples must match") call json%destroy(root) return end if call json%get(val, "bonds.connections.index", list, found=found) call json%get(val, "bonds.order", order, found=found) if (.not.allocated(order) .and. allocated(list)) & allocate(order(size(list)/2), source=1) if (json%failed()) then call fatal_error(error, "Cannot read entries from 'bonds'") call json%destroy(root) return end if if (allocated(list)) then allocate(bond(3, size(list)/2)) do ibond = 1, size(bond, 2) bond(:, ibond) = [list(2*ibond-1) + 1, list(2*ibond) + 1, order(ibond)] end do end if call json%get(val, "name", comment, default="") call json%get(val, "properties.totalCharge", charge, found=found) if (.not.found) then call json%get(val, "atoms.formalCharges", list, found=found) charge = 0 if (allocated(list)) charge = sum(list) end if call json%get(val, "properties.totalSpinMultiplicity", multiplicity, found=found) if (.not.found) multiplicity = 1 if (json%failed()) then call json%check_for_errors(error_msg=message) call fatal_error(error, message) call json%destroy(root) return end if xyz(1:3, 1:size(geo)/3) => geo xyz(:, :) = xyz * aatoau if (.not.cartesian) then xyz(:, :) = matmul(lattice, xyz(:, :)) end if call new(self, num, xyz, lattice=lattice, charge=real(charge, wp), uhf=multiplicity - 1) if (len(comment) > 0) self%comment = comment if (allocated(bond)) then self%nbd = size(bond, 2) call move_alloc(bond, self%bond) end if call json%destroy(root) contains subroutine cjson_get(json, val, key1, key2, child) type(json_core), intent(inout) :: json type(json_value), pointer, intent(in) :: val type(json_value), pointer, intent(out) :: child character(*), intent(in) :: key1, key2 logical :: found call json%get(val, key1, child, found=found) if (.not.found) then call json%get(val, key2, child, found=found) end if end subroutine cjson_get #else call fatal_error(error, "JSON support not enabled") #endif end subroutine read_cjson !> Calculate the lattice vectors from a set of cell parameters pure subroutine cell_to_dlat(cellpar, lattice) !> Cell parameters real(wp), intent(in) :: cellpar(6) !> Direct lattice real(wp), intent(out) :: lattice(:, :) real(wp) :: dvol dvol = cell_to_dvol(cellpar) associate(alen => cellpar(1), blen => cellpar(2), clen => cellpar(3), & & alp => cellpar(4), bet => cellpar(5), gam => cellpar(6)) lattice(1, 1) = alen lattice(2, 1) = 0.0_wp lattice(3, 1) = 0.0_wp lattice(3, 2) = 0.0_wp lattice(1, 2) = blen*cos(gam) lattice(2, 2) = blen*sin(gam) lattice(1, 3) = clen*cos(bet) lattice(2, 3) = clen*(cos(alp) - cos(bet)*cos(gam))/sin(gam); lattice(3, 3) = dvol/(alen*blen*sin(gam)) end associate end subroutine cell_to_dlat !> Calculate the cell volume from a set of cell parameters pure function cell_to_dvol(cellpar) result(dvol) !> Cell parameters real(wp), intent(in) :: cellpar(6) !> Cell volume real(wp) :: dvol real(wp) :: vol2 associate(alen => cellpar(1), blen => cellpar(2), clen => cellpar(3), & & alp => cellpar(4), bet => cellpar(5), gam => cellpar(6) ) vol2 = 1.0_wp - cos(alp)**2 - cos(bet)**2 - cos(gam)**2 & & + 2.0_wp*cos(alp)*cos(bet)*cos(gam) dvol = sqrt(abs(vol2))*alen*blen*clen ! return negative volume instead of imaginary one (means bad cell parameters) if (vol2 < 0.0_wp) dvol = -dvol ! this should not happen, but who knows... end associate end function cell_to_dvol end module mctc_io_read_cjson mctc-lib-0.3.2/src/mctc/io/read/ctfile.f90000066400000000000000000000446701466406626700200670ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_ctfile use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_convert, only : aatoau use mctc_io_structure, only : structure_type, new use mctc_io_structure_info, only : sdf_data, structure_info use mctc_io_symbols, only : to_number, symbol_length use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_token, read_next_token, to_string implicit none private public :: read_sdf, read_molfile contains subroutine read_sdf(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: line integer :: stat, lnum, pos call read_molfile(self, unit, error) if (allocated(error)) return lnum = 0 stat = 0 do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (index(line, '$$$$') == 1) exit end do if (stat /= 0) then call fatal_error(error, "Failed while reading SDF key-value pairs") return end if end subroutine read_sdf subroutine read_molfile(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: line character(len=:), allocatable :: comment integer :: stat, lnum, pos integer :: number_of_atoms, number_of_bonds integer :: list7(7), list12(12) real(wp) :: x, y, z character(len=2) :: sdf_dim logical :: two_dim, v3k type(token_type) :: token lnum = 0 two_dim = .false. call next_line(unit, comment, pos, lnum, stat) call next_line(unit, line, pos, lnum, stat) read(line, '(20x, a2)', iostat=stat) sdf_dim if (stat == 0) then two_dim = sdf_dim == '2D' .or. sdf_dim == '2d' end if call next_line(unit, line, pos, lnum, stat) call next_line(unit, line, pos, lnum, stat) if (stat == 0) then token = token_type(1, 3) call read_token(line, token, number_of_atoms, stat) end if if (stat == 0) then token = token_type(4, 6) call read_token(line, token, number_of_bonds, stat) end if if (stat /= 0) then call io_error(error, "Cannot read header of molfile", & & line, token, filename(unit), lnum, "expected integer value") return end if token = token_type(35, 39) stat = 1 if (len(line) >= 39) then v3k = line(35:39) == 'V3000' if (line(35:39) == 'V2000' .or. v3k) stat = 0 end if if (stat /= 0) then call io_error(error, "Format version not supported", & & line, token, filename(unit), lnum, "invalid format version") return end if if (.not.v3k .and. number_of_atoms < 1) then call io_error(error, "Invalid number of atoms", & & line, token_type(1, 3), filename(unit), lnum, "expected positive integer") return end if if (v3k) then call read_molfile_v3k(self, unit, error) else call read_molfile_v2k(self, unit, number_of_atoms, number_of_bonds, error) end if if (allocated(error)) return ! Attach additional meta data self%info%two_dimensional = two_dim if (len(comment) > 0) self%comment = comment end subroutine read_molfile subroutine read_molfile_v2k(self, unit, number_of_atoms, number_of_bonds, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Number of atoms from header integer, intent(in) :: number_of_atoms !> Number of bonds from header integer, intent(in) :: number_of_bonds !> Error handling type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: line integer :: i, iatom, jatom, ibond, btype, atomtype integer :: stat, length, charge(2, 15), lnum, pos integer :: list7(7), list12(12) real(wp) :: x, y, z character(len=3) :: symbol integer, parameter :: ccc_to_charge(0:7) = [0, +3, +2, +1, 0, -1, -2, -3] type(token_type) :: token character(len=symbol_length), allocatable :: sym(:) type(sdf_data), allocatable :: sdf(:) type(structure_info) :: info real(wp), allocatable :: xyz(:, :) integer, allocatable :: bond(:, :) lnum = 4 allocate(sdf(number_of_atoms)) allocate(xyz(3, number_of_atoms)) allocate(sym(number_of_atoms)) do iatom = 1, number_of_atoms call next_line(unit, line, pos, lnum, stat) if (stat == 0) then token = token_type(1, 10) call read_token(line, token, x, stat) end if if (stat == 0) then token = token_type(11, 20) call read_token(line, token, y, stat) end if if (stat == 0) then token = token_type(21, 30) call read_token(line, token, z, stat) end if if (len(line) >= 34) then symbol = line(32:34) end if if (stat == 0) then token = token_type(35, 36) call read_token(line, token, list12(1), stat) end if list12(:) = 0 do i = 1, 11 if (stat == 0) then if ((36+i*3) > len(line)) exit token = token_type(34 + i*3, 36 + i*3) call read_token(line, token, list12(i+1), stat) end if end do if (stat /= 0) then call io_error(error, "Cannot read coordinates from connection table", & & line, token, filename(unit), lnum, "unexpected value") return end if atomtype = to_number(symbol) if (atomtype == 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, token_type(32, 34), filename(unit), lnum, "unknown element") return end if xyz(:, iatom) = [x, y, z] * aatoau sym(iatom) = symbol sdf(iatom)%isotope = list12(1) sdf(iatom)%charge = ccc_to_charge(list12(2)) ! drop doublet radical sdf(iatom)%hydrogens = list12(4) sdf(iatom)%valence = list12(6) end do allocate(bond(3, number_of_bonds)) do ibond = 1, number_of_bonds call next_line(unit, line, pos, lnum, stat) list7(:) = 0 do i = 1, 7 if (stat == 0) then if ((i*3) > len(line)) exit token = token_type(i*3 - 2, i*3) call read_token(line, token, list7(i), stat) end if end do if (stat /= 0) then call io_error(error, "Cannot read topology from connection table", & & line, token, filename(unit), lnum, "unexpected value") return end if iatom = list7(1) jatom = list7(2) btype = list7(3) bond(:, ibond) = [iatom, jatom, btype] end do do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (index(line, 'M END') == 1) exit if (index(line, 'M CHG') == 1) then token = token_type(7, 9) read(line(7:9), *) length call read_token(line, token, length, stat) if (stat == 0) then do i = 1, length if (stat /= 0) exit token = token_type(3 + i*8, 5 + i*8) call read_token(line, token, charge(1, i), stat) if (charge(1, i) > number_of_atoms .or. charge(1, i) < 1) stat = 1 if (stat /= 0) exit token = token_type(7 + i*8, 9 + i*8) call read_token(line, token, charge(2, i), stat) end do end if if (stat /= 0) then call io_error(error, "Cannot read charges", & & line, token, filename(unit), lnum, "expected integer value") return end if do i = 1, length sdf(charge(1, i))%charge = charge(2, i) end do end if end do if (stat /= 0) then call fatal_error(error, "Cannot read connection table") return end if info = structure_info(missing_hydrogen=any(sdf%hydrogens > 1)) call new(self, sym, xyz, charge=real(sum(sdf%charge), wp), info=info, bond=bond) call move_alloc(sdf, self%sdf) end subroutine read_molfile_v2k subroutine read_molfile_v3k(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: line, group integer :: i, iatom, jatom, ibond, btype, atomtype, aamap, equal integer :: stat, charge(2, 15), lnum, pos, number_of_atoms, number_of_bonds, dummy real(wp) :: x, y, z character(len=3) :: symbol integer, parameter :: ccc_to_charge(0:7) = [0, +3, +2, +1, 0, -1, -2, -3] type(token_type) :: token, tsym character(len=symbol_length), allocatable :: sym(:) type(sdf_data), allocatable :: sdf(:) type(structure_info) :: info real(wp), allocatable :: xyz(:, :) integer, allocatable :: bond(:, :) lnum = 4 call next_v30(unit, line, pos, lnum, stat) do while(stat == 0) call next_token(line, pos, token) if (slice(line, token%first, token%last) == 'BEGIN') then call next_token(line, pos, token) if (slice(line, token%first, token%last) == 'CTAB') exit end if call next_v30(unit, line, pos, lnum, stat) end do if (stat /= 0) then call io_error(error, "Cannot read connection table", & & line, token_type(0, 0), filename(unit), lnum, "CTAB header not found") return end if call next_v30(unit, line, pos, lnum, stat) if (stat == 0) then call next_token(line, pos, token) if (slice(line, token%first, token%last) /= 'COUNTS') then call io_error(error, "Cannot read connection table", & & line, token, filename(unit), lnum, "COUNTS header not found") return end if end if if (stat == 0) then call read_next_token(line, pos, token, number_of_atoms, stat) tsym = token end if if (stat == 0) & call read_next_token(line, pos, token, number_of_bonds, stat) if (stat == 0) & call read_next_token(line, pos, token, dummy, stat) if (stat == 0) & call read_next_token(line, pos, token, dummy, stat) if (stat == 0) & call read_next_token(line, pos, token, dummy, stat) if (stat /= 0) then call io_error(error, "Cannot read connection table counts", & & line, token, filename(unit), lnum, "expected integer value") return end if if (number_of_atoms < 1) then call io_error(error, "Invalid number of atoms", & & line, tsym, filename(unit), lnum, "expected positive integer") return end if allocate(sdf(number_of_atoms)) allocate(xyz(3, number_of_atoms)) allocate(sym(number_of_atoms)) allocate(bond(3, number_of_bonds)) call next_v30(unit, line, pos, lnum, stat) do while(stat == 0) call next_token(line, pos, token) if (slice(line, token%first, token%last) == 'END') exit if (slice(line, token%first, token%last) == 'BEGIN') then call next_token(line, pos, token) group = slice(line, token%first, token%last) select case(group) case("ATOM") do iatom = 1, number_of_atoms call next_v30(unit, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, dummy, stat) if (stat == 0) & call next_token(line, pos, tsym) if (stat == 0) & call read_next_token(line, pos, token, x, stat) if (stat == 0) & call read_next_token(line, pos, token, y, stat) if (stat == 0) & call read_next_token(line, pos, token, z, stat) if (stat == 0) & call read_next_token(line, pos, token, aamap, stat) if (stat /= 0) then call io_error(error, "Cannot read coordinates", & & line, token, filename(unit), lnum, "unexpected value") return end if if (aamap > 0) then call io_error(error, "Mapping atoms is not supported", & & line, token, filename(unit), lnum, "unsupported value") return end if tsym%last = min(tsym%last, tsym%first + symbol_length - 1) sym(iatom) = slice(line, tsym%first, tsym%last) if (to_number(sym(iatom)) == 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, tsym, filename(unit), lnum, "unknown element") return end if xyz(:, iatom) = [x, y, z] * aatoau sdf(iatom) = sdf_data() do while(pos < len(line)) call next_token(line, pos, token) equal = index(slice(line, token%first, token%last), '=') + token%first - 1 if (equal > token%first) then select case(slice(line, token%first, equal - 1)) case("CHG") token%first = equal + 1 call read_token(line, token, sdf(iatom)%charge, stat) case("VAL") token%first = equal + 1 call read_token(line, token, sdf(iatom)%valence, stat) case("HCOUNT") token%first = equal + 1 call read_token(line, token, sdf(iatom)%hydrogens, stat) end select end if if (stat /= 0) then call io_error(error, "Cannot read atom properties", & & line, token, filename(unit), lnum, "unexpected value") return end if end do end do call next_v30(unit, line, pos, lnum, stat) call next_token(line, pos, token) case("BOND") do ibond = 1, number_of_bonds call next_v30(unit, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, dummy, stat) if (stat == 0) & call read_next_token(line, pos, token, btype, stat) if (stat == 0) & call read_next_token(line, pos, token, iatom, stat) if (stat == 0) & call read_next_token(line, pos, token, jatom, stat) if (stat /= 0) then call io_error(error, "Cannot read bond information", & & line, token, filename(unit), lnum, "expected integer value") return end if bond(:, ibond) = [iatom, jatom, btype] end do call next_v30(unit, line, pos, lnum, stat) call next_token(line, pos, token) case("COLLECTION", "SGROUP", "OBJ3D") do while(stat == 0) call next_v30(unit, line, pos, lnum, stat) call next_token(line, pos, token) if (slice(line, token%first, token%last) == 'END') exit end do case default call io_error(error, "Cannot read connection table", & & line, token, filename(unit), lnum, "Unknown entry found") return end select if (slice(line, token%first, token%last) /= 'END') then call io_error(error, group//" block is not terminated", & & line, token, filename(unit), lnum, "expected END label") return end if call next_token(line, pos, token) if (slice(line, token%first, token%last) /= group) then call io_error(error, group//" block is not terminated", & & line, token, filename(unit), lnum, "expected "//group//" label") return end if end if call next_v30(unit, line, pos, lnum, stat) end do if (slice(line, token%first, token%last) /= 'END') then call io_error(error, "Connection table is not terminated", & & line, token, filename(unit), lnum, "expected END label") return end if call next_token(line, pos, token) if (slice(line, token%first, token%last) /= 'CTAB') then call io_error(error, "Connection table is not terminated", & & line, token, filename(unit), lnum, "expected ATOM label") return end if call next_v30(unit, line, pos, lnum, stat) do while(stat == 0) call next_token(line, pos, token) if (slice(line, token%first, token%last) == 'END') exit end do if (stat /= 0) then call io_error(error, "Connection table is not terminated", & & line, token, filename(unit), lnum, "expected END label") return end if info = structure_info(missing_hydrogen=any(sdf%hydrogens > 1)) call new(self, sym, xyz, charge=real(sum(sdf%charge), wp), info=info, bond=bond) call move_alloc(sdf, self%sdf) end subroutine read_molfile_v3k function slice(string, first, last) character(len=*), intent(in), target :: string integer, intent(in) :: first, last character(len=:), pointer :: slice slice => string(max(first, 1):min(last, len(string))) end function slice subroutine next_v30(unit, line, pos, lnum, iostat, iomsg) !> Formatted IO unit integer, intent(in) :: unit !> Line to read character(len=:), allocatable, intent(out) :: line !> Current position in line integer, intent(out) :: pos !> Current line number integer, intent(inout) :: lnum !> Status of operation integer, intent(out) :: iostat !> Error message character(len=:), allocatable, optional :: iomsg call next_line(unit, line, pos, lnum, iostat, iomsg) if (iostat /= 0) return if (index(line, 'M END') == 1) pos = 3 if (index(line, 'M V30') == 1) pos = 6 end subroutine next_v30 end module mctc_io_read_ctfile mctc-lib-0.3.2/src/mctc/io/read/gaussian.f90000066400000000000000000000074721466406626700204320ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_gaussian use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_structure, only : structure_type, new use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_token, to_string implicit none private public :: read_gaussian_external contains subroutine read_gaussian_external(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error integer :: stat, n, mode, chrg, spin, iat, ii, pos, lnum type(token_type) :: token, tnat character(len=:), allocatable :: line integer, allocatable :: at(:) real(wp), allocatable :: xyz(:,:) real(wp) :: coord(3), q lnum = 0 call next_line(unit, line, pos, lnum, stat) if (stat == 0) then token = token_type(1, 10) tnat = token call read_token(line, token, n, stat) end if if (stat == 0) then token = token_type(11, 20) call read_token(line, token, mode, stat) end if if (stat == 0) then token = token_type(21, 30) call read_token(line, token, chrg, stat) end if if (stat == 0) then token = token_type(31, 40) call read_token(line, token, spin, stat) end if if (stat /= 0) then call io_error(error, "Could not read number of atoms", & & line, token, filename(unit), lnum, "expected integer value") return end if if (n <= 0) then call io_error(error, "Found no atoms, cannot work without atoms!", & & line, tnat, filename(unit), lnum, "expected positive integer") return end if allocate(xyz(3, n)) allocate(at(n)) ii = 0 do while (ii < n) call next_line(unit, line, pos, lnum, stat) if (is_iostat_end(stat)) exit if (stat == 0) then token = token_type(1, 10) tnat = token call read_token(line, token, iat, stat) end if if (stat == 0) then token = token_type(11, 30) call read_token(line, token, coord(1), stat) end if if (stat == 0) then token = token_type(31, 50) call read_token(line, token, coord(2), stat) end if if (stat == 0) then token = token_type(51, 70) call read_token(line, token, coord(3), stat) end if if (stat == 0) then token = token_type(71, 90) call read_token(line, token, q, stat) end if if (stat /= 0) then call io_error(error, "Could not read geometry from Gaussian file", & & line, token, filename(unit), lnum, "unexpected value") return end if if (iat > 0) then ii = ii+1 at(ii) = iat xyz(:, ii) = coord else call io_error(error, "Invalid atomic number", & & line, tnat, filename(unit), lnum, "expected positive integer") return end if end do call new(self, at, xyz, charge=real(chrg, wp), uhf=spin) if (ii /= n) then call fatal_error(error, "Atom number missmatch in Gaussian file") return end if end subroutine read_gaussian_external end module mctc_io_read_gaussian mctc-lib-0.3.2/src/mctc/io/read/genformat.f90000066400000000000000000000166061466406626700206010ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_genformat use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type use mctc_io_constants, only : pi use mctc_io_convert, only : aatoau use mctc_io_structure, only : structure_type, new use mctc_io_structure_info, only : structure_info use mctc_io_symbols, only : to_number, symbol_length use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_next_token, to_string implicit none private public :: read_genformat contains subroutine read_genformat(mol, unit, error) !> Instance of the molecular structure data type(structure_type),intent(out) :: mol !> File handle integer,intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error character(len=:), allocatable :: line integer :: natoms, nspecies, iatom, dummy, isp, ilat, stat, istart, iend logical :: cartesian, periodic(3) real(wp) :: coord(3), origin(3) character(len=1) :: variant type(token_type) :: token character(len=symbol_length), allocatable :: species(:), sym(:) real(wp), allocatable :: xyz(:, :), abc(:, :), lattice(:, :) type(structure_info) :: info integer :: pos, lnum lnum = 0 call advance_line(unit, line, pos, lnum, stat) call read_next_token(line, pos, token, natoms, stat) if (stat /= 0 .or. natoms < 1) then call io_error(error, "Could not read number of atoms", & & line, token, filename(unit), lnum, "expected integer value") return end if allocate(species(natoms)) allocate(sym(natoms)) allocate(xyz(3, natoms)) allocate(abc(3, natoms)) call next_token(line, pos, token) select case(line(token%first:token%last)) case('c', 'C') cartesian = .true. periodic = .false. case('s', 'S') cartesian = .true. periodic = .true. allocate(lattice(3, 3), source=0.0_wp) case('f', 'F') cartesian = .false. periodic = .true. allocate(lattice(3, 3), source=0.0_wp) case('h', 'H') cartesian = .true. periodic = [.false., .false., .true.] allocate(lattice(3, 1), source=0.0_wp) case default call io_error(error, "Invalid input version found", & & line, token, filename(unit), lnum, "unknown identifier") return end select call advance_line(unit, line, pos, lnum, stat) isp = 0 do while(pos < len(line)) call next_token(line, pos, token) isp = isp + 1 token%last = min(token%last, token%first + symbol_length - 1) species(isp) = line(token%first:token%last) if (to_number(species(isp)) == 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, token, filename(unit), lnum, "unknown element") return end if end do nspecies = isp do iatom = 1, natoms token = token_type(0, 0) call advance_line(unit, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, dummy, stat) if (stat == 0) & call read_next_token(line, pos, token, isp, stat) if (stat == 0) & call read_next_token(line, pos, token, coord(1), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(2), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(3), stat) if (stat /= 0) then call io_error(error, "Cannot read coordinates", & & line, token, filename(unit), lnum, "unexpected value") return end if sym(iatom) = species(isp) if (cartesian) then xyz(:, iatom) = coord * aatoau else abc(:, iatom) = coord end if end do if (any(periodic)) then call advance_line(unit, line, pos, lnum, stat) if (stat /= 0) then call io_error(error, "Unexpected end of file", & & line, token_type(0, 0), filename(unit), lnum, "missing lattice information") return end if if (stat == 0) & call read_next_token(line, pos, token, origin(1), stat) if (stat == 0) & call read_next_token(line, pos, token, origin(2), stat) if (stat == 0) & call read_next_token(line, pos, token, origin(3), stat) if (stat /= 0) then call io_error(error, "Cannot read origin", & & line, token, filename(unit), lnum, "expected real value") return end if end if if (all(periodic)) then do ilat = 1, 3 call advance_line(unit, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, coord(1), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(2), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(3), stat) if (stat /= 0) then call io_error(error, "Cannot read lattice vector", & & line, token, filename(unit), lnum, "expected real value") return end if lattice(:, ilat) = coord * aatoau end do if (.not.cartesian) then xyz = matmul(lattice, abc) end if end if if (count(periodic) == 1) then call advance_line(unit, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, coord(1), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(2), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(3), stat) if (stat /= 0) then call io_error(error, "Cannot read lattice vector", & & line, token, filename(unit), lnum, "expected real value") return end if if (coord(3) < 1) then call io_error(error, "Invalid helical axis rotation order", & & line, token, filename(unit), lnum, "expected positive value") return end if ! Store helical axis in *first* lattice vector, however it is not an actual ! lattice vector as on would expect but a screw axis lattice(:, 1) = [coord(1) * aatoau, coord(2) * pi / 180.0_wp, coord(3)] end if if (any(periodic)) then xyz(:, :) = xyz - spread(origin, 2, natoms) end if info = structure_info(cartesian=cartesian) call new(mol, sym, xyz, lattice=lattice, periodic=periodic, info=info) contains subroutine advance_line(unit, line, pos, num, stat) integer,intent(in) :: unit integer, intent(out) :: pos integer, intent(inout) :: num character(len=:), allocatable, intent(out) :: line integer, intent(out) :: stat integer :: ihash stat = 0 do while(stat == 0) call next_line(unit, line, pos, num, stat) ihash = index(line, '#') if (ihash > 0) line = line(:ihash-1) if (len_trim(line) > 0) exit end do line = trim(adjustl(line)) end subroutine advance_line end subroutine read_genformat end module mctc_io_read_genformat mctc-lib-0.3.2/src/mctc/io/read/meson.build000066400000000000000000000014031466406626700204260ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. srcs += files( 'aims.f90', 'cjson.F90', 'ctfile.f90', 'gaussian.f90', 'genformat.f90', 'qchem.f90', 'qcschema.F90', 'pdb.f90', 'turbomole.f90', 'vasp.f90', 'xyz.f90', ) mctc-lib-0.3.2/src/mctc/io/read/pdb.f90000066400000000000000000000127521466406626700173620ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_pdb use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type use mctc_io_convert, only : aatoau use mctc_io_resize, only : resize use mctc_io_symbols, only : to_number, symbol_length use mctc_io_structure, only : structure_type, new use mctc_io_structure_info, only : pdb_data, resize use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_token, to_string implicit none private public :: read_pdb contains subroutine read_pdb(self, unit, error) !> Instance of the molecular structure data type(structure_type),intent(out) :: self !> File handle integer,intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error integer, parameter :: p_initial_size = 1000 ! this is going to be a protein integer :: iatom, jatom, iresidue, try, stat, atom_type, pos, lnum real(wp) :: occ, temp, coords(3) real(wp), allocatable :: xyz(:,:) type(token_type) :: token character(len=4) :: a_charge character(len=:), allocatable :: line character(len=symbol_length), allocatable :: sym(:) type(pdb_data), allocatable :: pdb(:) allocate(sym(p_initial_size), source=repeat(' ', symbol_length)) allocate(xyz(3, p_initial_size), source=0.0_wp) allocate(pdb(p_initial_size), source=pdb_data()) iatom = 0 iresidue = 0 stat = 0 do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (index(line, 'END') == 1) exit if (index(line, 'ATOM') == 1 .or. index(line, 'HETATM') == 1) then if (iatom >= size(xyz, 2)) call resize(xyz) if (iatom >= size(sym)) call resize(sym) if (iatom >= size(pdb)) call resize(pdb) iatom = iatom + 1 pdb(iatom)%het = index(line, 'HETATM') == 1 if (len(line) >= 78) then ! a4: 13:16, a1: 17:17, a3: 18:20, a1: 22:22 ! a1: 27:27, a4: 73:76, a2: 77:78, a2: 79:80 pdb(iatom)%name = line(13:16) pdb(iatom)%loc = line(17:17) pdb(iatom)%residue = line(18:20) pdb(iatom)%chains = line(22:22) pdb(iatom)%code = line(27:27) pdb(iatom)%segid = line(72:74) sym(iatom) = line(77:78) else token = token_type(len(line)+1, len(line)+1) call io_error(error, "Too few entries provided in record", & & line, token, filename(unit), lnum, "record too short") return end if if (len(line) >= 80) then a_charge = line(79:80) else a_charge = "" end if if (stat == 0) then ! i5: 7-11 token = token_type(7, 11) call read_token(line, token, jatom, stat) end if if (stat == 0) then ! i4: 23-26 token = token_type(23, 26) call read_token(line, token, pdb(iatom)%residue_number, stat) end if if (stat == 0) then ! f8: 31-38 token = token_type(31, 38) call read_token(line, token, coords(1), stat) end if if (stat == 0) then ! f8: 39-46 token = token_type(39, 46) call read_token(line, token, coords(2), stat) end if if (stat == 0) then ! f8: 47-54 token = token_type(47, 54) call read_token(line, token, coords(3), stat) end if if (stat == 0) then ! f6: 55-60 token = token_type(55, 60) call read_token(line, token, occ, stat) end if if (stat == 0) then ! f6: 61-66 token = token_type(60, 66) call read_token(line, token, temp, stat) end if if (stat /= 0) then call io_error(error, "Cannot read coordinates from record", & & line, token, filename(unit), lnum, "unexpected value") return end if xyz(:,iatom) = coords * aatoau atom_type = to_number(sym(iatom)) if (atom_type == 0) then try = scan(pdb(iatom)%name, 'HCNOSPF') if (try > 0) sym(iatom) = pdb(iatom)%name(try:try)//' ' pdb(iatom)%charge = 0 else read(a_charge(1:1), *, iostat=stat) pdb(iatom)%charge if (stat /= 0) then stat = 0 pdb(iatom)%charge = 0 else if (a_charge(2:2) == '-') pdb(iatom)%charge = -pdb(iatom)%charge end if end if if (to_number(sym(iatom)) == 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, token_type(77, 78), filename(unit), lnum, "unknown element") return end if end if end do call new(self, sym(:iatom), xyz(:, :iatom)) self%pdb = pdb(:iatom) self%charge = sum(pdb(:iatom)%charge) end subroutine read_pdb end module mctc_io_read_pdb mctc-lib-0.3.2/src/mctc/io/read/qchem.f90000066400000000000000000000117241466406626700177100ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_qchem use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type use mctc_io_convert, only : aatoau use mctc_io_resize, only : resize use mctc_io_symbols, only : symbol_length, to_number, to_symbol use mctc_io_structure, only : structure_type, new use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_next_token, read_token implicit none private public :: read_qchem integer, parameter :: initial_size = 64 contains subroutine read_qchem(mol, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: mol !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error integer :: stat, pos, lnum, izp, iat integer :: charge, multiplicity type(token_type) :: token character(len=:), allocatable :: line real(wp) :: x, y, z character(len=symbol_length), allocatable :: sym(:) real(wp), allocatable :: xyz(:, :), abc(:, :), lattice(:, :) logical :: is_frac, periodic(3) iat = 0 lnum = 0 stat = 0 do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (stat /= 0) exit call next_token(line, pos, token) if (token%first > len(line)) cycle if (to_lower(line(token%first:token%last)) == '$molecule') exit end do if (stat /= 0) then call io_error(error, "No atoms found", & & line, token_type(0, 0), filename(unit), lnum+1, "expected molecule block") return end if call next_line(unit, line, pos, lnum, stat) if (stat == 0) & call read_next_token(line, pos, token, charge, stat) if (stat == 0) & call read_next_token(line, pos, token, multiplicity, stat) if (stat /= 0) then call io_error(error, "Failed to read charge and multiplicity", & & line, token, filename(unit), lnum, "expected integer value") return end if allocate(sym(initial_size), source=repeat(' ', symbol_length)) allocate(xyz(3, initial_size), source=0.0_wp) do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (stat /= 0) exit call next_token(line, pos, token) if (to_lower(line(token%first:token%last)) == '$end') exit if (iat >= size(sym)) call resize(sym) if (iat >= size(xyz, 2)) call resize(xyz) iat = iat + 1 token%last = min(token%last, token%first + symbol_length - 1) sym(iat) = line(token%first:token%last) if (to_number(sym(iat)) == 0) then call read_token(line, token, izp, stat) sym(iat) = to_symbol(izp) end if if (stat /= 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, token, filename(unit), lnum, "unknown element") return end if call read_next_token(line, pos, token, x, stat) if (stat == 0) & call read_next_token(line, pos, token, y, stat) if (stat == 0) & call read_next_token(line, pos, token, z, stat) if (stat /= 0) then call io_error(error, "Cannot read coordinates", & & line, token, filename(unit), lnum, "expected real value") return end if xyz(:, iat) = [x, y, z] * aatoau end do if (stat /= 0) then call io_error(error, "Failed to read molecule block", & & line, token_type(0, 0), filename(unit), lnum, "unexpected end of input") return end if call new(mol, sym(:iat), xyz, charge=real(charge, wp), uhf=multiplicity-1) end subroutine read_qchem !> Convert input string to lowercase elemental function to_lower(str) result(lcstr) !> Input string character(len=*), intent(in) :: str !> Lowercase version of string character(len=len(str)):: lcstr integer :: ilen, iquote, i, iav, iqc integer, parameter :: offset = iachar('A') - iachar('a') ilen = len(str) iquote = 0 lcstr = str do i = 1, ilen iav = iachar(str(i:i)) if (iquote == 0 .and. (iav == 34 .or.iav == 39)) then iquote = 1 iqc = iav cycle end if if (iquote == 1 .and. iav==iqc) then iquote=0 cycle end if if (iquote == 1) cycle if (iav >= iachar('A') .and. iav <= iachar('Z')) then lcstr(i:i) = achar(iav - offset) else lcstr(i:i) = str(i:i) end if end do end function to_lower end module mctc_io_read_qchem mctc-lib-0.3.2/src/mctc/io/read/qcschema.F90000066400000000000000000000124411466406626700203340ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. #include "mctc/defs.h" module mctc_io_read_qcschema use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_structure, only : structure_type, new use mctc_io_symbols, only : to_number, symbol_length use mctc_io_utils, only : getline #if WITH_JSON use json_value_module, only : json_core, json_value #endif implicit none private public :: read_qcschema contains subroutine read_qcschema(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error #if WITH_JSON type(json_core) :: json type(json_value), pointer :: root, val, child, array integer :: stat, schema_version, charge, multiplicity, ibond character(len=:), allocatable :: input, line, message, schema_name, comment character(len=symbol_length), allocatable :: sym(:) integer, allocatable :: bond(:, :), list(:) real(wp), allocatable, target :: geo(:) real(wp), pointer :: xyz(:, :) stat = 0 input = "" do call getline(unit, line, stat) if (stat /= 0) exit input = input // line end do call json%deserialize(root, input) if (json%failed()) then call json%check_for_errors(error_msg=message) call fatal_error(error, message) call json%destroy(root) return end if val => root call json%get(val, "schema_version", schema_version, default=2) call json%get(val, "schema_name", schema_name, default="qcschema_molecule") if (schema_name /= "qcschema_molecule" .and. schema_name /= "qcschema_input" & & .or. json%failed()) then call fatal_error(error, "Invalid schema name '"//schema_name//"'") call json%destroy(root) return end if if (schema_name == "qcschema_input") then select case(schema_version) case(1) call json%get(val, "molecule", child) case default call fatal_error(error, "Unsupported schema version for 'qcschema_input'") call json%destroy(root) return end select call json%get(child, "schema_version", schema_version, default=2) call json%get(child, "schema_name", schema_name, default="qcschema_molecule") if (schema_name /= "qcschema_molecule" .or. json%failed()) then call fatal_error(error, "Invalid schema name '"//schema_name//"'") call json%destroy(root) return end if val => child end if select case(schema_version) case(1) call json%get(val, "molecule", child) case(2) child => val case default call fatal_error(error, "Unsupported schema version for 'qcschema_molecule'") call json%destroy(root) return end select call json%get(child, "symbols", sym) if (.not.allocated(sym) .or. json%failed()) then call fatal_error(error, "List of atomic symbols must be provided") call json%destroy(root) return end if call json%get(child, "geometry", geo) if (.not.allocated(geo) .or. json%failed()) then call fatal_error(error, "Cartesian coordinates must be provided") call json%destroy(root) return end if if (3*size(sym) /= size(geo)) then call fatal_error(error, "Number of symbols and coordinate triples must match") call json%destroy(root) return end if call json%get(child, "comment", comment, default="") call json%get(child, "molecular_charge", charge, default=0) call json%get(child, "molecular_multiplicity", multiplicity, default=1) if (json%failed()) then call json%check_for_errors(error_msg=message) call fatal_error(error, message) call json%destroy(root) return end if call json%get_child(child, "connectivity", array) if (associated(array)) then allocate(bond(3, json%count(array))) do ibond = 1, size(bond, 2) call json%get_child(array, ibond, child) call json%get(child, "", list) if (allocated(list)) then bond(:, ibond) = [list(1)+1, list(2)+1, list(3)] end if end do if (json%failed()) then call json%check_for_errors(error_msg=message) call fatal_error(error, message) call json%destroy(root) return end if end if xyz(1:3, 1:size(geo)/3) => geo call new(self, sym, xyz, charge=real(charge, wp), uhf=multiplicity-1) if (len(comment) > 0) self%comment = comment if (allocated(bond)) then self%nbd = size(bond, 2) call move_alloc(bond, self%bond) end if call json%destroy(root) #else call fatal_error(error, "JSON support not enabled") #endif end subroutine read_qcschema end module mctc_io_read_qcschema mctc-lib-0.3.2/src/mctc/io/read/turbomole.f90000066400000000000000000000365201466406626700206240ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_turbomole use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type use mctc_io_constants, only : pi use mctc_io_convert, only : aatoau use mctc_io_resize, only : resize use mctc_io_structure, only : structure_type, new use mctc_io_structure_info, only : structure_info use mctc_io_symbols, only : to_number, symbol_length use mctc_io_utils, only : next_line, token_type, next_token, io_error, io2_error, & filename, read_next_token, to_string implicit none private public :: read_coord logical, parameter :: debug = .false. contains subroutine read_coord(mol, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: mol !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error character, parameter :: flag = '$' integer, parameter :: p_initial_size = 100 integer, parameter :: p_nlv(3) = [1, 4, 9], p_ncp(3) = [1, 3, 6] logical :: has_coord, has_periodic, has_lattice, has_cell, has_eht logical :: cartesian, coord_in_bohr, lattice_in_bohr, pbc(3) integer :: stat, iatom, i, j, natoms, periodic, cell_vectors, icharge, unpaired integer :: lnum, pos, lcell, llattice, lperiodic, lcoord, leht type(token_type) :: token, token2 real(wp) :: latvec(9), conv, cellpar(6), lattice(3, 3) real(wp), allocatable :: coord(:, :), xyz(:, :), charge character(len=:), allocatable :: line, cell_string, lattice_string, & & line_cell, line_lattice, line_periodic, line_coord, line_eht character(len=symbol_length), allocatable :: sym(:) type(structure_info) :: info allocate(sym(p_initial_size), source=repeat(' ', symbol_length)) allocate(coord(3, p_initial_size), source=0.0_wp) lnum = 0 iatom = 0 periodic = 0 cell_vectors = 0 has_eht = .false. has_coord = .false. has_periodic = .false. has_lattice = .false. has_cell = .false. cartesian = .true. coord_in_bohr = .true. lattice_in_bohr = .true. lattice(:, :) = 0.0_wp pbc(:) = .false. charge = 0.0_wp unpaired = 0 stat = 0 call next_line(unit, line, pos, lnum, stat) do while(stat == 0) if (index(line, flag) == 1) then call next_token(line, pos, token) select case(line(token%first:token%last)) case('$end') exit case('$eht') if (has_eht) then pos = 0 call next_token(line_eht, pos, token2) call io2_error(error, "Duplicated eht data group", & & line_eht, line, token2, token, & & filename(unit), leht, lnum, & & "charge/multiplicity first defined here", "duplicated eht data") return end if has_eht = .true. leht = lnum line_eht = line i = index(line, 'charge=') if (i > 0) then pos = i + 6 call read_next_token(line, pos, token, icharge, stat) charge = real(icharge, wp) end if j = index(line, 'unpaired=') if (j > 0 .and. stat == 0) then pos = j + 8 call read_next_token(line, pos, token, unpaired, stat) end if if (stat /= 0) then call io_error(error, "Cannot read eht entry", & & line, token, filename(unit), lnum, "expected integer value") return end if case('$coord') if (has_coord) then pos = 0 call next_token(line_coord, pos, token2) call io2_error(error, "Duplicated coord data group", & & line_coord, line, token2, token, & & filename(unit), lcoord, lnum, & & "coordinates first defined here", "duplicated coordinate group") return end if lcoord = lnum line_coord = line has_coord = .true. ! $coord angs / $coord bohr / $coord frac call select_unit(line, coord_in_bohr, cartesian) coord_group: do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (index(line, flag) == 1) exit coord_group if (iatom >= size(coord, 2)) call resize(coord) if (iatom >= size(sym)) call resize(sym) iatom = iatom + 1 call read_next_token(line, pos, token, coord(1, iatom), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(2, iatom), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(3, iatom), stat) if (stat == 0) & call next_token(line, pos, token) if (stat /= 0) then call io_error(error, "Cannot read coordinates", & & line, token, filename(unit), lnum, "expected real value") return end if token%last = min(token%last, token%first + symbol_length - 1) sym(iatom) = line(token%first:token%last) if (to_number(sym(iatom)) == 0) then call io_error(error, "Cannot map symbol to atomic number", & & line, token, filename(unit), lnum, "unknown element") return end if end do coord_group cycle case('$periodic') if (has_periodic) then pos = 0 call next_token(line_periodic, pos, token2) call io2_error(error, "Duplicated periodic data group", & & line_periodic, line, token2, token, & & filename(unit), lperiodic, lnum, & & "periodicity first defined here", "duplicated periodicity data") return end if lperiodic = lnum line_periodic = line has_periodic = .true. ! $periodic 0/1/2/3 call read_next_token(line, pos, token, periodic, stat) if (stat /= 0 .or. periodic < 0 .or. periodic > 3) then call io_error(error, "Cannot read periodicity of system", & & line, token, filename(unit), lnum, "expected integer (0 to 3)") return end if case('$lattice') if (has_lattice) then pos = 0 call next_token(line_lattice, pos, token2) call io2_error(error, "Duplicated lattice data group", & & line_lattice, line, token2, token, & & filename(unit), llattice, lnum, & & "lattice parameters first defined here", "duplicated lattice group") return end if llattice = lnum line_lattice = line has_lattice = .true. ! $lattice bohr / $lattice angs call select_unit(line, lattice_in_bohr) cell_vectors = 0 lattice_string = '' lattice_group: do while(stat == 0) call next_line(unit, line, pos, lnum, stat) if (index(line, flag) == 1) exit lattice_group cell_vectors = cell_vectors + 1 lattice_string = lattice_string // ' ' // line end do lattice_group cycle case('$cell') if (has_cell) then pos = 0 call next_token(line_cell, pos, token2) call io2_error(error, "Duplicated cell data group", & & line_cell, line, token2, token, & & filename(unit), lcell, lnum, & & "cell parameters first defined here", "duplicated cell group") return end if lcell = lnum line_cell = line has_cell = .true. ! $cell bohr / $cell angs call select_unit(line, lattice_in_bohr) call next_line(unit, cell_string, pos, lnum, stat) if (debug) print*, cell_string end select end if token = token_type(0, 0) call next_line(unit, line, pos, lnum, stat) end do if (allocated(error)) return if (.not.has_coord .or. iatom == 0) then call io_error(error, "coordinates not present, cannot work without coordinates", & & line, token, filename(unit), lnum, "unexpected end of input") return end if if (has_cell .and. has_lattice) then block type(token_type) :: tcell, tlattice pos = 0 call next_token(line_cell, pos, tcell) pos = 0 call next_token(line_lattice, pos, tlattice) tlattice = token_type(1, len(line_lattice)) if (lcell > llattice) then call io2_error(error, "Conflicting lattice and cell groups", & & line_lattice, line_cell, tlattice, tcell, & & filename(unit), llattice, lcell, & & "lattice first defined here", "conflicting cell group") else call io2_error(error, "Conflicting lattice and cell groups", & & line_cell, line_lattice, tcell, tlattice, & & filename(unit), lcell, llattice, & & "cell first defined here", "conflicting lattice group") end if end block return end if if (.not.has_periodic .and. (has_cell .or. has_lattice)) then pos = 0 if (has_cell) then call next_token(line_cell, pos, token) call io_error(error, "Cell parameters defined without periodicity", & & line_cell, token, filename(unit), & & lcell, "cell defined here") end if if (has_lattice) then call next_token(line_lattice, pos, token) call io_error(error, "Lattice parameters defined without periodicity", & & line_lattice, token, filename(unit), & & llattice, "lattice defined here") end if return end if if (periodic > 0 .and. .not.(has_cell .or. has_lattice)) then pos = 0 call next_token(line_periodic, pos, token) call io_error(error, "Missing lattice or cell data", & & line_periodic, token, filename(unit), & & lperiodic, "periodic system defined here") return end if if (.not.cartesian .and. periodic == 0) then pos = 0 call next_token(line_coord, pos, token) call next_token(line_coord, pos, token) call io_error(error, "Molecular systems cannot have fractional coordinates", & & line_coord, token, filename(unit), & & lcoord, "fractional modifier found") return end if natoms = iatom allocate(xyz(3, natoms)) if (periodic > 0) pbc(:periodic) = .true. if (has_cell) then read(cell_string, *, iostat=stat) latvec(:p_ncp(periodic)) if (debug) print*, latvec(:p_ncp(periodic)) if (lattice_in_bohr) then conv = 1.0_wp else conv = aatoau end if select case(periodic) case(1) cellpar = [latvec(1)*conv, 1.0_wp, 1.0_wp, & & pi/2, pi/2, pi/2] case(2) cellpar = [latvec(1)*conv, latvec(2)*conv, 1.0_wp, & & pi/2, pi/2, latvec(3)*pi/180.0_wp] case(3) cellpar = [latvec(1:3)*conv, latvec(4:6)*pi/180.0_wp] end select call cell_to_dlat(cellpar, lattice) end if if (has_lattice) then if (cell_vectors /= periodic) then pos = 0 call next_token(line_lattice, pos, token) pos = len_trim(line_periodic) call io2_error(error, "Number of lattice vectors does not match periodicity", & & line_lattice, line_periodic, token, token_type(pos, pos), & & filename(unit), llattice, lperiodic, & & "lattice vectors defined here", "conflicting periodicity") return end if read(lattice_string, *, iostat=stat) latvec(:p_nlv(periodic)) if (lattice_in_bohr) then conv = 1.0_wp else conv = aatoau end if j = 0 do i = 1, periodic lattice(:periodic, i) = latvec(j+1:j+periodic) * conv j = j + periodic end do end if if (cartesian) then if (coord_in_bohr) then conv = 1.0_wp else conv = aatoau end if xyz(:, :) = coord(:, :natoms) * conv else ! Non-periodic coordinates are in Bohr xyz(periodic+1:3, :) = coord(periodic+1:3, :natoms) ! Periodic coordinates must still be transformed with lattice xyz(:periodic, :) = matmul(lattice(:periodic, :periodic), coord(:periodic, :natoms)) end if ! save data on input format info = structure_info(cartesian=cartesian, lattice=has_lattice, & & angs_lattice=.not.lattice_in_bohr, angs_coord=.not.coord_in_bohr) call new(mol, sym(:natoms), xyz, charge=charge, uhf=unpaired, & & lattice=lattice, periodic=pbc, info=info) contains subroutine select_unit(line, in_bohr, cartesian) character(len=*), intent(in) :: line logical, intent(out) :: in_bohr logical, intent(out), optional :: cartesian in_bohr = index(line, ' angs') == 0 if (present(cartesian)) cartesian = index(line, ' frac') == 0 end subroutine select_unit end subroutine read_coord !> Calculate the lattice vectors from a set of cell parameters pure subroutine cell_to_dlat(cellpar, lattice) !> Cell parameters real(wp), intent(in) :: cellpar(6) !> Direct lattice real(wp), intent(out) :: lattice(:, :) real(wp) :: dvol dvol = cell_to_dvol(cellpar) associate(alen => cellpar(1), blen => cellpar(2), clen => cellpar(3), & & alp => cellpar(4), bet => cellpar(5), gam => cellpar(6)) lattice(1, 1) = alen lattice(2, 1) = 0.0_wp lattice(3, 1) = 0.0_wp lattice(3, 2) = 0.0_wp lattice(1, 2) = blen*cos(gam) lattice(2, 2) = blen*sin(gam) lattice(1, 3) = clen*cos(bet) lattice(2, 3) = clen*(cos(alp) - cos(bet)*cos(gam))/sin(gam); lattice(3, 3) = dvol/(alen*blen*sin(gam)) end associate end subroutine cell_to_dlat !> Calculate the cell volume from a set of cell parameters pure function cell_to_dvol(cellpar) result(dvol) !> Cell parameters real(wp), intent(in) :: cellpar(6) !> Cell volume real(wp) :: dvol real(wp) :: vol2 associate(alen => cellpar(1), blen => cellpar(2), clen => cellpar(3), & & alp => cellpar(4), bet => cellpar(5), gam => cellpar(6) ) vol2 = 1.0_wp - cos(alp)**2 - cos(bet)**2 - cos(gam)**2 & & + 2.0_wp*cos(alp)*cos(bet)*cos(gam) dvol = sqrt(abs(vol2))*alen*blen*clen ! return negative volume instead of imaginary one (means bad cell parameters) if (vol2 < 0.0_wp) dvol = -dvol ! this should not happen, but who knows... end associate end function cell_to_dvol end module mctc_io_read_turbomole mctc-lib-0.3.2/src/mctc/io/read/vasp.f90000066400000000000000000000163601466406626700175650ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_vasp use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_convert, only : aatoau use mctc_io_resize, only : resize use mctc_io_structure, only : structure_type, new use mctc_io_structure_info, only : structure_info use mctc_io_symbols, only : to_number, symbol_length use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_next_token, to_string implicit none private public :: read_vasp contains subroutine read_vasp(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error logical :: selective, cartesian integer :: i, j, k, nn, ntype, natoms, izp, stat, pos, lnum integer, allocatable :: ncount(:) real(wp) :: ddum, latvec(3), scalar, coord(3), lattice(3, 3) real(wp), allocatable :: xyz(:, :) type(token_type) :: token character(len=:), allocatable :: line, comment character(len=2*symbol_length), allocatable :: args(:), args2(:) character(len=symbol_length), allocatable :: sym(:) type(structure_info) :: info selective = .false. ! Selective dynamics cartesian = .true. ! Cartesian or direct lattice = 0 stat = 0 lnum = 0 ntype = 0 ! first line contains the symbols of different atom types call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of input encountered") return end if call parse_line(" " // line, args, ntype) call move_alloc(line, comment) ! this line contains the global scaling factor, call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of input encountered") return end if call read_next_token(line, pos, token, ddum, stat) if (stat /= 0) then call io_error(error, "Cannot read scaling factor", & & line, token, filename(unit), lnum, "expected real value") return end if ! the Ang->au conversion is included in the scaling factor scalar = ddum*aatoau ! reading the lattice constants do i = 1, 3 call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of lattice vectors encountered") return end if call read_next_token(line, pos, token, latvec(1), stat) if (stat == 0) & call read_next_token(line, pos, token, latvec(2), stat) if (stat == 0) & call read_next_token(line, pos, token, latvec(3), stat) if (stat /= 0) then call io_error(error, "Cannot read lattice vectors from input", & & line, token, filename(unit), lnum, "expected real value") return end if lattice(:, i) = latvec * scalar end do ! Either here are the numbers of each element, ! or (>vasp.5.1) here are the element symbols call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of input encountered") return end if ! try to verify that first element is actually a number i = max(verify(line, ' '), 1) j = scan(line(i:), ' ') - 2 + i if (j < i) j = len_trim(line) ! CONTCAR files have additional Element line here since vasp.5.1 if (verify(line(i:j), '1234567890') /= 0) then call parse_line(" " // line, args, ntype) call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of input encountered") return end if else deallocate(comment) end if call parse_line(" " // line, args2, nn) if (nn /= ntype) then call fatal_error(error, 'Number of atom types mismatches the number of counts') return end if allocate(ncount(nn), source = 0) do i = 1, nn read(args2(i), *, iostat=stat) ncount(i) izp = to_number(args(i)) if (izp < 1 .or. ncount(i) < 1) then call fatal_error(error, "Unknown element '"//trim(args(i))//"' encountered") return end if end do natoms = sum(ncount) allocate(sym(natoms)) allocate(xyz(3, natoms)) k = 0 do i = 1, nn do j = 1, ncount(i) k = k+1 sym(k) = trim(args(i)) end do end do call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Could not read POSCAR") return end if line = adjustl(line) if (line(:1).eq.'s' .or. line(:1).eq.'S') then selective = .true. call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of input encountered") return end if line = adjustl(line) end if cartesian = (line(:1).eq.'c' .or. line(:1).eq.'C' .or. & & line(:1).eq.'k' .or. line(:1).eq.'K') do i = 1, natoms call next_line(unit, line, pos, lnum, stat) if (stat /= 0) then call fatal_error(error, "Unexpected end of geometry encountered") return end if call read_next_token(line, pos, token, coord(1), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(2), stat) if (stat == 0) & call read_next_token(line, pos, token, coord(3), stat) if (stat /= 0) then call io_error(error, "Cannot read geometry from input", & & line, token, filename(unit), lnum, "expected real value") return end if if (cartesian) then xyz(:, i) = coord*scalar else xyz(:, i) = matmul(lattice, coord) end if end do ! save information about this POSCAR for later info = structure_info(scale=ddum, selective=selective, cartesian=cartesian) call new(self, sym, xyz, lattice=lattice, info=info) if (allocated(comment)) self%comment = comment end subroutine read_vasp subroutine parse_line(line, args, nargs) character(len=*), intent(in) :: line character(len=2*symbol_length), allocatable, intent(out) :: args(:) integer, intent(out) :: nargs integer, parameter :: p_initial_size = 50 integer :: istart, iend allocate(args(p_initial_size), source=repeat(' ', 2*symbol_length)) istart = 1 iend = 1 nargs = 0 do while(iend < len_trim(line)) istart = verify(line(iend:), ' ') - 1 + iend iend = scan(line(istart:), ' ') - 1 + istart if (iend < istart) iend = len_trim(line) if (nargs >= size(args)) then call resize(args) end if nargs = nargs + 1 args(nargs) = trim(line(istart:iend)) end do end subroutine parse_line end module mctc_io_read_vasp mctc-lib-0.3.2/src/mctc/io/read/xyz.f90000066400000000000000000000102371466406626700174430ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_read_xyz use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error use mctc_io_convert, only : aatoau use mctc_io_structure, only : structure_type, new use mctc_io_symbols, only : to_number, to_symbol, symbol_length use mctc_io_utils, only : next_line, token_type, next_token, io_error, filename, & read_next_token, to_string implicit none private public :: read_xyz contains subroutine read_xyz(self, unit, error) !> Instance of the molecular structure data type(structure_type), intent(out) :: self !> File handle integer, intent(in) :: unit !> Error handling type(error_type), allocatable, intent(out) :: error integer :: ii, n, iat, stat, pos, lnum real(wp) :: x, y, z, conv real(wp), allocatable :: xyz(:, :) type(token_type) :: token, tsym, tnat character(len=symbol_length) :: chdum character(len=symbol_length), allocatable :: sym(:) character(len=:), allocatable :: line, comment, fline conv = aatoau lnum = 0 call next_line(unit, fline, pos, lnum, stat) call read_next_token(fline, pos, tnat, n, stat) if (stat /= 0) then call io_error(error, "Could not read number of atoms", & & fline, tnat, filename(unit), lnum, "expected integer value") return end if if (n.lt.1) then call io_error(error, "Impossible number of atoms provided", & & fline, tnat, filename(unit), lnum, "expected positive integer value") return end if allocate(sym(n)) allocate(xyz(3, n)) ! next record is a comment call next_line(unit, comment, pos, lnum, stat) if (stat /= 0) then call io_error(error, "Unexpected end of file", & & "", token_type(0, 0), filename(unit), lnum+1, "expected value") return end if ii = 0 do while (ii < n) call next_line(unit, line, pos, lnum, stat) if (is_iostat_end(stat)) exit if (stat /= 0) then call io_error(error, "Could not read geometry from xyz file", & & "", token_type(0, 0), filename(unit), lnum+1, "expected value") return end if call next_token(line, pos, tsym) if (stat == 0) & call read_next_token(line, pos, token, x, stat) if (stat == 0) & call read_next_token(line, pos, token, y, stat) if (stat == 0) & call read_next_token(line, pos, token, z, stat) if (stat /= 0) then call io_error(error, "Could not parse coordinates from xyz file", & & line, token, filename(unit), lnum, "expected real value") return end if ! Adjust the token length to faithfully report the used chars in case of an error tsym%last = min(tsym%last, tsym%first + symbol_length - 1) chdum = line(tsym%first:tsym%last) iat = to_number(chdum) if (iat <= 0) then read(chdum, *, iostat=stat) iat if (stat == 0) then chdum = to_symbol(iat) else iat = 0 end if end if if (iat > 0) then ii = ii+1 sym(ii) = trim(chdum) xyz(:, ii) = [x, y, z]*conv else call io_error(error, "Cannot map symbol to atomic number", & & line, tsym, filename(unit), lnum, "unknown element") return end if end do if (ii /= n) then call io_error(error, "Atom number missmatch in xyz file", & & fline, tnat, filename(unit), 1, "found "//to_string(ii)//" atoms in input") return end if call new(self, sym, xyz) if (len(comment) > 0) self%comment = comment end subroutine read_xyz end module mctc_io_read_xyz mctc-lib-0.3.2/src/mctc/io/resize.f90000066400000000000000000000117001466406626700171730ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Reallocation implementation for resizing arrays module mctc_io_resize use mctc_env_accuracy, only : wp implicit none private public :: resize !> Overloaded resize interface interface resize module procedure :: resize_char module procedure :: resize_int module procedure :: resize_logical module procedure :: resize_real module procedure :: resize_real_2d end interface resize !> Initial size for dynamic sized arrays integer, parameter :: initial_size = 64 contains !> Reallocate list of integers pure subroutine resize_int(var, n) !> Instance of the array to be resized integer, allocatable, intent(inout) :: var(:) !> Dimension of the final array size integer, intent(in), optional :: n integer, allocatable :: tmp(:) integer :: this_size, new_size if (allocated(var)) then this_size = size(var, 1) call move_alloc(var, tmp) else this_size = initial_size end if if (present(n)) then new_size = n else new_size = this_size + this_size/2 + 1 end if allocate(var(new_size)) if (allocated(tmp)) then this_size = min(size(tmp, 1), size(var, 1)) var(:this_size) = tmp(:this_size) deallocate(tmp) end if end subroutine resize_int !> Reallocate list of characters pure subroutine resize_char(var, n) !> Instance of the array to be resized character(len=*), allocatable, intent(inout) :: var(:) !> Dimension of the final array size integer, intent(in), optional :: n character(len=:), allocatable :: tmp(:) integer :: this_size, new_size if (allocated(var)) then this_size = size(var, 1) call move_alloc(var, tmp) else this_size = initial_size end if if (present(n)) then new_size = n else new_size = this_size + this_size/2 + 1 end if allocate(var(new_size)) if (allocated(tmp)) then this_size = min(size(tmp, 1), size(var, 1)) var(:this_size) = tmp(:this_size) deallocate(tmp) end if end subroutine resize_char !> Reallocate list of logicals pure subroutine resize_logical(var, n) !> Instance of the array to be resized logical, allocatable, intent(inout) :: var(:) !> Dimension of the final array size integer, intent(in), optional :: n logical, allocatable :: tmp(:) integer :: this_size, new_size if (allocated(var)) then this_size = size(var, 1) call move_alloc(var, tmp) else this_size = initial_size end if if (present(n)) then new_size = n else new_size = this_size + this_size/2 + 1 end if allocate(var(new_size)) if (allocated(tmp)) then this_size = min(size(tmp, 1), size(var, 1)) var(:this_size) = tmp(:this_size) deallocate(tmp) end if end subroutine resize_logical !> Reallocate list of reals pure subroutine resize_real(var, n) !> Instance of the array to be resized real(wp), allocatable, intent(inout) :: var(:) !> Dimension of the final array size integer, intent(in), optional :: n real(wp), allocatable :: tmp(:) integer :: this_size, new_size if (allocated(var)) then this_size = size(var, 1) call move_alloc(var, tmp) else this_size = initial_size end if if (present(n)) then new_size = n else new_size = this_size + this_size/2 + 1 end if allocate(var(new_size)) if (allocated(tmp)) then this_size = min(size(tmp, 1), size(var, 1)) var(:this_size) = tmp(:this_size) deallocate(tmp) end if end subroutine resize_real !> Reallocate list of reals pure subroutine resize_real_2d(var, n) !> Instance of the array to be resized real(wp), allocatable, intent(inout) :: var(:,:) !> Dimension of the final array size integer, intent(in), optional :: n real(wp), allocatable :: tmp(:,:) integer :: order, this_size, new_size if (allocated(var)) then order = size(var, 1) this_size = size(var, 2) call move_alloc(var, tmp) else order = 3 this_size = initial_size end if if (present(n)) then new_size = n else new_size = this_size + this_size/2 + 1 end if allocate(var(order, new_size)) if (allocated(tmp)) then this_size = min(size(tmp, 2), size(var, 2)) var(:, :this_size) = tmp(:, :this_size) deallocate(tmp) end if end subroutine resize_real_2d end module mctc_io_resize mctc-lib-0.3.2/src/mctc/io/structure.f90000066400000000000000000000155631466406626700177450ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Basic structure representation of the system of interest module mctc_io_structure use mctc_env_accuracy, only : wp use mctc_io_symbols, only : to_number, to_symbol, symbol_length, get_identity, & & collect_identical use mctc_io_structure_info, only : structure_info, pdb_data, sdf_data implicit none private public :: structure_type, new_structure, new !> Structure representation type :: structure_type !> Number of atoms integer :: nat = 0 !> Number of unique species integer :: nid = 0 !> Number of bonds integer :: nbd = 0 !> Species identifier integer, allocatable :: id(:) !> Atomic number for each species integer, allocatable :: num(:) !> Element symbol for each species character(len=symbol_length), allocatable :: sym(:) !> Cartesian coordinates, in Bohr real(wp), allocatable :: xyz(:, :) !> Number of unpaired electrons integer :: uhf = 0 !> Total charge real(wp) :: charge = 0.0_wp !> Lattice parameters real(wp), allocatable :: lattice(:, :) !> Periodic directions logical, allocatable :: periodic(:) !> Bond indices integer, allocatable :: bond(:, :) !> Comment, name or identifier for this structure character(len=:), allocatable :: comment !> Vendor specific structure annotations type(structure_info) :: info = structure_info() !> SDF atomic data annotations type(sdf_data), allocatable :: sdf(:) !> PDB atomic data annotations type(pdb_data), allocatable :: pdb(:) end type structure_type interface new module procedure :: new_structure module procedure :: new_structure_num module procedure :: new_structure_sym end interface contains !> Constructor for structure representations subroutine new_structure(self, num, sym, xyz, charge, uhf, lattice, periodic, & & info, bond) !> Instance of the structure representation type(structure_type), intent(out) :: self !> Atomic numbers integer, intent(in) :: num(:) !> Element symbols character(len=*), intent(in) :: sym(:) !> Cartesian coordinates real(wp), intent(in) :: xyz(:, :) !> Total charge real(wp), intent(in), optional :: charge !> Number of unpaired electrons integer, intent(in), optional :: uhf !> Lattice parameters real(wp), intent(in), optional :: lattice(:, :) !> Periodic directions logical, intent(in), optional :: periodic(:) !> Vendor specific structure information type(structure_info), intent(in), optional :: info !> Bond topology of the system integer, intent(in), optional :: bond(:, :) integer :: ndim, iid integer, allocatable :: map(:) ndim = min(size(num, 1), size(xyz, 2), size(sym, 1)) self%nat = ndim allocate(self%id(ndim)) allocate(self%xyz(3, ndim)) if (present(lattice)) then self%lattice = lattice else allocate(self%lattice(0, 0)) end if if (present(periodic)) then self%periodic = periodic else if (present(lattice)) then allocate(self%periodic(3)) self%periodic(:) = .true. else allocate(self%periodic(1)) self%periodic(:) = .false. end if end if call get_identity(self%nid, self%id, sym) allocate(map(self%nid)) call collect_identical(self%id, map) allocate(self%num(self%nid)) allocate(self%sym(self%nid)) do iid = 1, self%nid self%num(iid) = num(map(iid)) self%sym(iid) = sym(map(iid)) end do self%xyz(:, :) = xyz(:, :ndim) if (present(charge)) then self%charge = charge else self%charge = 0.0_wp end if if (present(uhf)) then self%uhf = uhf else self%uhf = 0 end if if (present(info)) then self%info = info else self%info = structure_info() end if if (present(bond)) then self%nbd = size(bond, 2) self%bond = bond end if end subroutine new_structure !> Simplified constructor for structure representations subroutine new_structure_num(self, num, xyz, charge, uhf, lattice, periodic, & & info, bond) !> Instance of the structure representation type(structure_type), intent(out) :: self !> Atomic numbers integer, intent(in) :: num(:) !> Cartesian coordinates real(wp), intent(in) :: xyz(:, :) !> Total charge real(wp), intent(in), optional :: charge !> Number of unpaired electrons integer, intent(in), optional :: uhf !> Lattice parameters real(wp), intent(in), optional :: lattice(:, :) !> Periodic directions logical, intent(in), optional :: periodic(:) !> Vendor specific structure information type(structure_info), intent(in), optional :: info !> Bond topology of the system integer, intent(in), optional :: bond(:, :) integer :: ndim, iat character(len=symbol_length), allocatable :: sym(:) ndim = min(size(num, 1), size(xyz, 2)) allocate(sym(ndim)) do iat = 1, ndim sym(iat) = to_symbol(num(iat)) end do call new_structure(self, num, sym, xyz, charge, uhf, lattice, periodic, & & info, bond) end subroutine new_structure_num !> Simplified constructor for structure representations subroutine new_structure_sym(self, sym, xyz, charge, uhf, lattice, periodic, & & info, bond) !> Instance of the structure representation type(structure_type), intent(out) :: self !> Element symbols character(len=*), intent(in) :: sym(:) !> Cartesian coordinates real(wp), intent(in) :: xyz(:, :) !> Total charge real(wp), intent(in), optional :: charge !> Number of unpaired electrons integer, intent(in), optional :: uhf !> Lattice parameters real(wp), intent(in), optional :: lattice(:, :) !> Periodic directions logical, intent(in), optional :: periodic(:) !> Vendor specific structure information type(structure_info), intent(in), optional :: info !> Bond topology of the system integer, intent(in), optional :: bond(:, :) integer :: ndim, iat integer, allocatable :: num(:) ndim = min(size(sym, 1), size(xyz, 2)) allocate(num(ndim)) do iat = 1, ndim num(iat) = to_number(sym(iat)) end do call new_structure(self, num, sym, xyz, charge, uhf, lattice, periodic, & & info, bond) end subroutine new_structure_sym end module mctc_io_structure mctc-lib-0.3.2/src/mctc/io/structure/000077500000000000000000000000001466406626700174135ustar00rootroot00000000000000mctc-lib-0.3.2/src/mctc/io/structure/CMakeLists.txt000066400000000000000000000012701466406626700221530ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. set(dir "${CMAKE_CURRENT_SOURCE_DIR}") list( APPEND srcs "${dir}/info.f90" ) set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/io/structure/info.f90000066400000000000000000000074031466406626700206720ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_structure_info use mctc_env_accuracy, only : wp implicit none private public :: pdb_data, sdf_data, structure_info public :: resize !> Atomic pdb data type. !> !> keeps information from PDB input that is currently not used by the !> caller program (like residues or chains) but is needed to write !> the PDB output eventually !> !> ATOM 2461 HA3 GLY A 153 -10.977 -7.661 2.011 1.00 0.00 H !> TER 2462 GLY A 153 !> a6----i5---xa4--aa3-xai4--axxxf8.3----f8.3----f8.3----f6.2--f6.2--xxxxxxa4--a2a2 !> HETATM 2463 CHA HEM A 154 9.596 -13.100 10.368 1.00 0.00 C type :: pdb_data logical :: het = .false. integer :: charge = 0 integer :: residue_number = 0 character(len=4) :: name = ' ' character(len=1) :: loc = ' ' character(len=3) :: residue = ' ' character(len=1) :: chains = ' ' character(len=1) :: code = ' ' character(len=4) :: segid = ' ' end type pdb_data !> SDF atomic data. !> !> We only support some entries, the rest is simply dropped. !> the format is: ddcccssshhhbbbvvvHHHrrriiimmmnnneee type :: sdf_data integer :: isotope = 0 !< d field integer :: charge = 0 !< c field integer :: hydrogens = 0 !< h field integer :: valence = 0 !< v field end type sdf_data !> structure input info !> !> contains informations from different input file formats type :: structure_info !> Vasp coordinate scaling information real(wp) :: scale = 1.0_wp !> Vasp selective dynamics keyword is present logical :: selective = .false. !> SDF 2D structure present logical :: two_dimensional = .false. !> SDF hydrogen query present or PDB without hydrogen atoms found logical :: missing_hydrogen = .false. !> Periodic coordinates should use preferably cartesian coordinates logical :: cartesian = .true. !> Lattice information should use preferably lattice vectors logical :: lattice = .true. !> Unit of the lattice vectors should be in Angstrom if possible logical :: angs_lattice = .false. !> Unit of the atomic coordinates should be in Angstrom if possible logical :: angs_coord = .false. end type structure_info interface resize module procedure resize_pdb_data end interface contains subroutine resize_pdb_data(var, n) type(pdb_data), allocatable, intent(inout) :: var(:) integer, intent(in), optional :: n type(pdb_data), allocatable :: tmp(:) integer :: length, current_length current_length = size(var) if (current_length > 0) then if (present(n)) then if (n <= current_length) return length = n else length = current_length + current_length/2 + 1 endif allocate(tmp(length), source=pdb_data()) tmp(:current_length) = var(:current_length) deallocate(var) call move_alloc(tmp, var) else if (present(n)) then length = n else length = 64 endif allocate(var(length), source=pdb_data()) endif end subroutine resize_pdb_data end module mctc_io_structure_info mctc-lib-0.3.2/src/mctc/io/structure/meson.build000066400000000000000000000011431466406626700215540ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. srcs += files( 'info.f90', ) mctc-lib-0.3.2/src/mctc/io/symbols.f90000066400000000000000000000227671466406626700174010ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Handle conversion between element symbols and atomic numbers module mctc_io_symbols use mctc_io_resize, only : resize implicit none private public :: symbol_length public :: symbol_to_number, number_to_symbol, number_to_lcsymbol public :: to_number, to_symbol, to_lcsymbol public :: get_identity, collect_identical !> Get chemical identity interface get_identity module procedure :: get_identity_number module procedure :: get_identity_symbol end interface get_identity !> Maximum allowed length of element symbols integer, parameter :: symbol_length = 4 !> Periodic system of elements character(len=2), parameter :: pse(118) = [ & & 'H ','He', & & 'Li','Be','B ','C ','N ','O ','F ','Ne', & & 'Na','Mg','Al','Si','P ','S ','Cl','Ar', & & 'K ','Ca', & & 'Sc','Ti','V ','Cr','Mn','Fe','Co','Ni','Cu','Zn', & & 'Ga','Ge','As','Se','Br','Kr', & & 'Rb','Sr', & & 'Y ','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd', & & 'In','Sn','Sb','Te','I ','Xe', & & 'Cs','Ba', & & 'La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb', & & 'Lu','Hf','Ta','W ','Re','Os','Ir','Pt','Au','Hg', & & 'Tl','Pb','Bi','Po','At','Rn', & & 'Fr','Ra', & & 'Ac','Th','Pa','U ','Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md','No', & & 'Lr','Rf','Db','Sg','Bh','Hs','Mt','Ds','Rg','Cn', & & 'Nh','Fl','Mc','Lv','Ts','Og' ] !> Lower case version of the periodic system of elements character(len=2), parameter :: lcpse(118) = [ & & 'h ','he', & & 'li','be','b ','c ','n ','o ','f ','ne', & & 'na','mg','al','si','p ','s ','cl','ar', & & 'k ','ca', & & 'sc','ti','v ','cr','mn','fe','co','ni','cu','zn', & & 'ga','ge','as','se','br','kr', & & 'rb','sr', & & 'y ','zr','nb','mo','tc','ru','rh','pd','ag','cd', & & 'in','sn','sb','te','i ','xe', & & 'cs','ba','la', & & 'ce','pr','nd','pm','sm','eu','gd','tb','dy','ho','er','tm','yb', & & 'lu','hf','ta','w ','re','os','ir','pt','au','hg', & & 'tl','pb','bi','po','at','rn', & & 'fr','ra','ac', & & 'th','pa','u ','np','pu','am','cm','bk','cf','es','fm','md','no', & & 'lr','rf','db','sg','bh','hs','mt','ds','rg','cn', & & 'nh','fl','mc','lv','ts','og' ] !> ASCII offset between lowercase and uppercase letters integer, parameter :: offset = iachar('a') - iachar('A') contains !> Convert element symbol to atomic number elemental subroutine symbol_to_number(number, symbol) !> Element symbol character(len=*), intent(in) :: symbol !> Atomic number integer, intent(out) :: number character(len=2) :: lcsymbol integer :: i, j, k, l number = 0 lcsymbol = ' ' k = 0 do j = 1, len_trim(symbol) if (k > 2) exit l = iachar(symbol(j:j)) if (k >= 1 .and. l == iachar(' ')) exit if (k >= 1 .and. l == 9) exit if (l >= iachar('A') .and. l <= iachar('Z')) l = l + offset if (l >= iachar('a') .and. l <= iachar('z')) then k = k+1 if (k > 2) exit lcsymbol(k:k) = achar(l) endif enddo do i = 1, size(lcpse) if (lcsymbol == lcpse(i)) then number = i exit endif enddo if (number == 0) then select case(lcsymbol) case('d ', 't ') number = 1 end select end if end subroutine symbol_to_number !> Convert atomic number to element symbol elemental subroutine number_to_symbol(symbol, number) !> Atomic number integer, intent(in) :: number !> Element symbol character(len=2), intent(out) :: symbol if (number <= 0 .or. number > size(pse)) then symbol = '--' else symbol = pse(number) endif end subroutine number_to_symbol !> Convert atomic number to element symbol elemental subroutine number_to_lcsymbol(symbol, number) !> Atomic number integer, intent(in) :: number !> Element symbol character(len=2), intent(out) :: symbol if (number <= 0 .or. number > size(lcpse)) then symbol = '--' else symbol = lcpse(number) endif end subroutine number_to_lcsymbol !> Convert element symbol to atomic number elemental function to_number(symbol) result(number) !> Element symbol character(len=*), intent(in) :: symbol !> Atomic number integer :: number call symbol_to_number(number, symbol) end function to_number !> Convert atomic number to element symbol elemental function to_symbol(number) result(symbol) !> Atomic number integer,intent(in) :: number !> Element symbol character(len=2) :: symbol call number_to_symbol(symbol, number) end function to_symbol !> Convert atomic number to element symbol elemental function to_lcsymbol(number) result(symbol) !> Atomic number integer,intent(in) :: number !> Element symbol character(len=2) :: symbol call number_to_lcsymbol(symbol, number) end function to_lcsymbol !> Get chemical identity from a list of atomic numbers pure subroutine get_identity_number(nid, identity, number) !> Number of unique species integer, intent(out) :: nid !> Ordinal numbers integer, intent(in) :: number(:) !> Chemical identity integer, intent(out) :: identity(:) integer, allocatable :: itmp(:) integer :: nat, iat, iid nat = size(identity) allocate(itmp(nat)) nid = 0 do iat = 1, nat iid = find_number(itmp(:nid), number(iat)) if (iid == 0) then call append_number(itmp, nid, number(iat)) iid = nid end if identity(iat) = iid end do end subroutine get_identity_number !> Get chemical identity from a list of element symbols pure subroutine get_identity_symbol(nid, identity, symbol) !> Number of unique species integer, intent(out) :: nid !> Element symbols character(len=*), intent(in) :: symbol(:) !> Chemical identity integer, intent(out) :: identity(:) character(len=len(symbol)), allocatable :: stmp(:) integer :: nat, iat, iid nat = size(identity) allocate(stmp(nat)) nid = 0 do iat = 1, nat iid = find_symbol(stmp(:nid), symbol(iat)) if (iid == 0) then call append_symbol(stmp, nid, symbol(iat)) iid = nid end if identity(iat) = iid end do end subroutine get_identity_symbol !> Establish a mapping between unique atom types and species pure subroutine collect_identical(identity, mapping) !> Chemical identity integer, intent(in) :: identity(:) !> Mapping from unique atoms integer, intent(out) :: mapping(:) integer :: iid, iat do iid = 1, size(mapping) do iat = 1, size(identity) if (identity(iat) == iid) then mapping(iid) = iat exit end if end do end do end subroutine collect_identical !> Find element symbol in an unordered list, all entries are required to be unique pure function find_symbol(list, symbol) result(position) !> List of element symbols character(len=*), intent(in) :: list(:) !> Element symbol character(len=*), intent(in) :: symbol !> Position of the symbol in list if found, otherwise zero integer :: position integer :: isym position = 0 do isym = 1, size(list) if (symbol == list(isym)) then position = isym exit end if end do end function find_symbol !> Find atomic number in an unordered list, all entries are required to be unique pure function find_number(list, number) result(position) !> List of atomic numbers integer, intent(in) :: list(:) !> Atomic number integer, intent(in) :: number !> Position of the number in list if found, otherwise zero integer :: position integer :: inum position = 0 do inum = 1, size(list) if (number == list(inum)) then position = inum exit end if end do end function find_number !> Append an element symbol to an unsorted list, to ensure no duplicates search !> for the element symbol first pure subroutine append_symbol(list, nlist, symbol) !> List of element symbols character(len=*), allocatable, intent(inout) :: list(:) !> Current occupied size of list integer, intent(inout) :: nlist !> Elements symbol character(len=*), intent(in) :: symbol if (nlist >= size(list)) then call resize(list) end if nlist = nlist + 1 list(nlist) = symbol end subroutine append_symbol !> Append an atomic number to an unsorted list, to ensure no duplicates search !> for the atomic number first pure subroutine append_number(list, nlist, number) !> List of atomic number integer, allocatable, intent(inout) :: list(:) !> Current occupied size of list integer, intent(inout) :: nlist !> Atomic number integer, intent(in) :: number if (nlist >= size(list)) then call resize(list) end if nlist = nlist + 1 list(nlist) = number end subroutine append_number end module mctc_io_symbols mctc-lib-0.3.2/src/mctc/io/utils.f90000066400000000000000000000264601466406626700170430ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_utils use mctc_env_accuracy, only : wp use mctc_env_error, only : error_type, fatal_error implicit none private public :: getline, next_line public :: token_type, next_token, read_token, read_next_token public :: io_error, io2_error public :: filename, to_string !> Text token type :: token_type !> Begin of sequence integer :: first !> End of sequence integer :: last end type token_type interface read_token module procedure :: read_token_int module procedure :: read_token_real end interface read_token interface read_next_token module procedure :: read_next_token_int module procedure :: read_next_token_real end interface read_next_token contains subroutine getline(unit, line, iostat, iomsg) !> Formatted IO unit integer, intent(in) :: unit !> Line to read character(len=:), allocatable, intent(out) :: line !> Status of operation integer, intent(out) :: iostat !> Error message character(len=:), allocatable, optional :: iomsg integer, parameter :: bufsize = 512 character(len=bufsize) :: buffer character(len=bufsize) :: msg integer :: size integer :: stat allocate(character(len=0) :: line) do read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=size) & & buffer if (stat > 0) exit line = line // buffer(:size) if (stat < 0) then if (is_iostat_eor(stat)) then stat = 0 end if exit end if end do if (stat /= 0) then if (present(iomsg)) iomsg = trim(msg) end if iostat = stat end subroutine getline !> Convenience function to read a line and update associated descriptors subroutine next_line(unit, line, pos, lnum, iostat, iomsg) !> Formatted IO unit integer, intent(in) :: unit !> Line to read character(len=:), allocatable, intent(out) :: line !> Current position in line integer, intent(out) :: pos !> Current line number integer, intent(inout) :: lnum !> Status of operation integer, intent(out) :: iostat !> Error message character(len=:), allocatable, optional :: iomsg pos = 0 call getline(unit, line, iostat, iomsg) if (iostat == 0) lnum = lnum + 1 end subroutine next_line !> Advance pointer to next text token subroutine next_token(string, pos, token) !> String to check character(len=*), intent(in) :: string !> Current position in string integer, intent(inout) :: pos !> Token found type(token_type), intent(out) :: token integer :: start if (pos >= len(string)) then token = token_type(len(string)+1, len(string)+1) return end if do while(pos < len(string)) pos = pos + 1 select case(string(pos:pos)) case(" ", achar(9), achar(10), achar(13)) continue case default exit end select end do start = pos do while(pos < len(string)) pos = pos + 1 select case(string(pos:pos)) case(" ", achar(9), achar(10), achar(13)) pos = pos - 1 exit case default continue end select end do token = token_type(start, pos) end subroutine next_token function filename(unit) integer, intent(in) :: unit character(len=:), allocatable :: filename character(len=512) :: buffer logical :: opened filename = "(input)" if (unit /= -1) then buffer = "" inquire(unit=unit, opened=opened, name=buffer) if (opened .and. len_trim(buffer) > 0) then filename = trim(buffer) end if end if end function !> Create new IO error subroutine io_error(error, message, source, token, filename, line, label) !> Error handler type(error_type), allocatable, intent(out) :: error !> Main error message character(len=*), intent(in) :: message !> String representing the offending input character(len=*), intent(in) :: source !> Last processed token type(token_type), intent(in) :: token !> Name of the input file character(len=*), intent(in), optional :: filename !> Line number integer, intent(in), optional :: line !> Label of the offending statement character(len=*), intent(in), optional :: label character(len=*), parameter :: nl = new_line('a') integer :: offset, lnum, width character(len=:), allocatable :: string lnum = 1 if (present(line)) lnum = line offset = integer_width(lnum) width = token%last - token%first + 1 string = "Error: " // message if (present(filename)) then string = string // nl // & repeat(" ", offset)//"--> "//filename string = string // ":" // to_string(lnum) if (token%first > 0 .and. token%last >= token%first) then string = string // & ":"//to_string(token%first) if (token%last > token%first) string = string//"-"//to_string(token%last) end if end if string = string // nl //& repeat(" ", offset+1)//"|"//nl//& to_string(lnum)//" | "//source//nl//& repeat(" ", offset+1)//"|"//repeat(" ", token%first)//repeat("^", width) if (present(label)) then string = string // " " // label end if string = string // nl //& repeat(" ", offset+1)//"|" call fatal_error(error, string) end subroutine io_error !> Create new IO error subroutine io2_error(error, message, source1, source2, token1, token2, filename, & & line1, line2, label1, label2) !> Error handler type(error_type), allocatable, intent(out) :: error !> Main error message character(len=*), intent(in) :: message !> String representing the offending input character(len=*), intent(in) :: source1, source2 !> Last processed token type(token_type), intent(in) :: token1, token2 !> Name of the input file character(len=*), intent(in), optional :: filename !> Line number integer, intent(in), optional :: line1, line2 !> Label of the offending statement character(len=*), intent(in), optional :: label1, label2 character(len=*), parameter :: nl = new_line('a') integer :: offset, lnum1, lnum2, width1, width2 character(len=:), allocatable :: string lnum1 = 1 lnum2 = 1 if (present(line1)) lnum1 = line1 if (present(line2)) lnum2 = line2 offset = integer_width(max(lnum1, lnum2)) width1 = token1%last - token1%first + 1 width2 = token2%last - token2%first + 1 string = "Error: " // message if (present(filename)) then string = string // nl // & repeat(" ", offset)//"--> "//filename string = string // ":" // to_string(lnum2) if (token2%first > 0 .and. token2%last >= token2%first) then string = string // & ":"//to_string(token2%first) if (token2%last > token2%first) string = string//"-"//to_string(token2%last) end if end if string = string // nl //& repeat(" ", offset+1)//"|"//nl//& to_string(lnum1, offset)//" | "//source1//nl//& repeat(" ", offset+1)//"|"//repeat(" ", token1%first)//repeat("-", width1) if (present(label1)) then string = string // " " // label1 end if string = string // nl //& repeat(" ", offset+1)//":"//nl//& to_string(lnum2)//" | "//source2//nl//& repeat(" ", offset+1)//"|"//repeat(" ", token2%first)//repeat("^", width2) if (present(label2)) then string = string // " " // label2 end if string = string // nl //& repeat(" ", offset+1)//"|" call fatal_error(error, string) end subroutine io2_error pure function integer_width(input) result(width) integer, intent(in) :: input integer :: width integer :: val val = input width = 0 do while (val /= 0) val = val / 10 width = width + 1 end do end function integer_width !> Represent an integer as character sequence. pure function to_string(val, width) result(string) integer, intent(in) :: val integer, intent(in), optional :: width character(len=:), allocatable :: string integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos integer :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] if (val == 0) then if (present(width)) then string = repeat(" ", width-1) // numbers(0) else string = numbers(0) end if return end if n = abs(val) buffer = "" pos = buffer_len + 1 do while (n > 0) pos = pos - 1 buffer(pos:pos) = numbers(mod(n, 10)) n = n/10 end do if (val < 0) then pos = pos - 1 buffer(pos:pos) = '-' end if if (present(width)) then string = repeat(" ", max(width-(buffer_len+1-pos), 0)) // buffer(pos:) else string = buffer(pos:) end if end function to_string subroutine read_next_token_int(line, pos, token, val, iostat, iomsg) character(len=*), intent(in) :: line integer, intent(inout) :: pos type(token_type), intent(inout) :: token integer, intent(out) :: val integer, intent(out) :: iostat character(len=:), allocatable, intent(out), optional :: iomsg character(len=512) :: msg call next_token(line, pos, token) call read_token(line, token, val, iostat, iomsg) end subroutine read_next_token_int subroutine read_token_int(line, token, val, iostat, iomsg) character(len=*), intent(in) :: line type(token_type), intent(in) :: token integer, intent(out) :: val integer, intent(out) :: iostat character(len=:), allocatable, intent(out), optional :: iomsg character(len=512) :: msg if (token%first > 0 .and. token%last <= len(line)) then read(line(token%first:token%last), *, iostat=iostat, iomsg=msg) val else iostat = 1 msg = "No input found" end if if (present(iomsg)) iomsg = trim(msg) end subroutine read_token_int subroutine read_next_token_real(line, pos, token, val, iostat, iomsg) character(len=*), intent(in) :: line integer, intent(inout) :: pos type(token_type), intent(inout) :: token real(wp), intent(out) :: val integer, intent(out) :: iostat character(len=:), allocatable, intent(out), optional :: iomsg call next_token(line, pos, token) call read_token(line, token, val, iostat, iomsg) end subroutine read_next_token_real subroutine read_token_real(line, token, val, iostat, iomsg) character(len=*), intent(in) :: line type(token_type), intent(in) :: token real(wp), intent(out) :: val integer, intent(out) :: iostat character(len=:), allocatable, intent(out), optional :: iomsg character(len=512) :: msg if (token%first > 0 .and. token%last <= len(line)) then read(line(token%first:token%last), *, iostat=iostat, iomsg=msg) val else iostat = 1 msg = "No input found" end if if (present(iomsg)) iomsg = trim(msg) end subroutine read_token_real end module mctc_io_utils mctc-lib-0.3.2/src/mctc/io/write.f90000066400000000000000000000076351466406626700170400ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write use mctc_env_error, only : error_type, fatal_error use mctc_io_filetype, only : filetype, get_filetype use mctc_io_write_aims, only : write_aims use mctc_io_write_cjson, only : write_cjson use mctc_io_write_ctfile, only : write_molfile, write_sdf use mctc_io_write_gaussian, only : write_gaussian_external use mctc_io_write_genformat, only : write_genformat use mctc_io_write_pdb, only : write_pdb use mctc_io_write_qchem, only : write_qchem use mctc_io_write_qcschema, only : write_qcschema use mctc_io_write_turbomole, only : write_coord use mctc_io_write_vasp, only : write_vasp use mctc_io_write_xyz, only : write_xyz use mctc_io_structure, only : structure_type, new_structure implicit none private public :: write_structure interface write_structure module procedure :: write_structure_to_file module procedure :: write_structure_to_unit end interface write_structure contains subroutine write_structure_to_file(self, file, error, format) !> Instance of the molecular structure data class(structure_type), intent(in) :: self !> Name of the file to read character(len=*), intent(in) :: file !> Error handling type(error_type), allocatable, intent(out) :: error !> File type format hint integer, intent(in), optional :: format integer :: unit, ftype, stat open(file=file, newunit=unit, iostat=stat) if (stat /= 0) then call fatal_error(error, "Cannot open '"//file//"'") return end if if (present(format)) then ftype = format else ftype = get_filetype(file) end if ! Unknown file type is unacceptable in this situation, ! try to figure at least something out if (ftype == filetype%unknown) then if (any(self%periodic)) then ftype = filetype%vasp else if (allocated(self%sdf)) then ftype = filetype%sdf else if (allocated(self%pdb)) then ftype = filetype%pdb else ftype = filetype%xyz end if end if call write_structure(self, unit, ftype, error) close(unit) end subroutine write_structure_to_file subroutine write_structure_to_unit(self, unit, ftype, error) !> Instance of the molecular structure data class(structure_type), intent(in) :: self !> File handle integer, intent(in) :: unit !> File type to read integer, intent(in) :: ftype !> Error handling type(error_type), allocatable, intent(out) :: error select case(ftype) case default call fatal_error(error, "Cannot write unknown file format") case(filetype%xyz) call write_xyz(self, unit) case(filetype%molfile) call write_molfile(self, unit) case(filetype%pdb) call write_pdb(self, unit) case(filetype%gen) call write_genformat(self, unit) case(filetype%sdf) call write_sdf(self, unit) case(filetype%vasp) call write_vasp(self, unit) case(filetype%tmol) call write_coord(self, unit) case(filetype%gaussian) call write_gaussian_external(self, unit) case(filetype%cjson) call write_cjson(self, unit) case(filetype%qcschema) call write_qcschema(self, unit) case(filetype%aims) call write_aims(self, unit) case(filetype%qchem) call write_qchem(self, unit) end select end subroutine write_structure_to_unit end module mctc_io_write mctc-lib-0.3.2/src/mctc/io/write/000077500000000000000000000000001466406626700165055ustar00rootroot00000000000000mctc-lib-0.3.2/src/mctc/io/write/CMakeLists.txt000066400000000000000000000016241466406626700212500ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. set(dir "${CMAKE_CURRENT_SOURCE_DIR}") list( APPEND srcs "${dir}/aims.f90" "${dir}/cjson.f90" "${dir}/ctfile.f90" "${dir}/gaussian.f90" "${dir}/genformat.f90" "${dir}/pdb.f90" "${dir}/qchem.f90" "${dir}/qcschema.f90" "${dir}/turbomole.f90" "${dir}/vasp.f90" "${dir}/xyz.f90" ) set(srcs "${srcs}" PARENT_SCOPE) mctc-lib-0.3.2/src/mctc/io/write/aims.f90000066400000000000000000000034031466406626700177560ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_aims use mctc_env_accuracy, only : wp use mctc_io_convert, only : autoaa use mctc_io_structure, only : structure_type implicit none private public :: write_aims contains subroutine write_aims(self, unit) !> Instance of the molecular structure data class(structure_type), intent(in) :: self !> File handle integer, intent(in) :: unit integer :: iat, ilt logical :: expo expo = maxval(self%xyz) > 1.0e+5 .or. minval(self%xyz) < -1.0e+5 if (expo) then do iat = 1, self%nat write(unit, '(a, 1x, 3es24.14, 1x, a)') & "atom", self%xyz(:, iat) * autoaa, trim(self%sym(self%id(iat))) end do else do iat = 1, self%nat write(unit, '(a, 1x, 3f24.14, 1x, a)') & "atom", self%xyz(:, iat) * autoaa, trim(self%sym(self%id(iat))) end do end if if (any(self%periodic)) then if (size(self%lattice, 2) /= 3) return do ilt = 1, 3 if (self%periodic(ilt)) then write(unit, '(a, 1x, 3f24.14)') & "lattice_vector", self%lattice(:, ilt) * autoaa end if end do end if end subroutine write_aims end module mctc_io_write_aims mctc-lib-0.3.2/src/mctc/io/write/cjson.f90000066400000000000000000000247271466406626700201550ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_cjson use mctc_env_accuracy, only : wp use mctc_io_constants, only : pi use mctc_io_convert, only : autoaa use mctc_io_math, only : matinv_3x3 use mctc_io_structure, only : structure_type implicit none private public :: write_cjson interface json_value module procedure :: json_value_char module procedure :: json_value_int module procedure :: json_value_real end interface json_value interface json_array module procedure :: json_array_char_1 module procedure :: json_array_int_1 module procedure :: json_array_real_1 end interface json_array character(len=*), parameter :: nl = new_line('a') contains subroutine write_cjson(mol, unit) type(structure_type), intent(in) :: mol integer, intent(in) :: unit write(unit, '(a)') json_string(mol, " ") end subroutine write_cjson pure function json_string(mol, indent) result(string) type(structure_type), intent(in) :: mol character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string real(wp), allocatable :: inv_lat(:, :) real(wp), allocatable :: abc(:, :) real(wp) :: cellpar(6) string = "{" if (present(indent)) string = string // nl // indent string = string // json_key("chemicalJson", indent) // json_value(1) if (allocated(mol%comment)) then string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("name", indent) // json_value(mol%comment) end if string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("atoms", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("elements", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 3) string = string // json_key("number", indent) // json_array(mol%num(mol%id), 3, indent) if (present(indent)) string = string // nl // repeat(indent, 2) string = string // "}" string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("coords", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 3) if (mol%info%cartesian) then string = string // json_key("3d", indent) // json_array([mol%xyz * autoaa], 3, indent) else inv_lat = matinv_3x3(mol%lattice) abc = matmul(inv_lat, mol%xyz) string = string // json_key("3dFractional", indent) // json_array([abc], 3, indent) end if if (present(indent)) string = string // nl // repeat(indent, 2) string = string // "}" if (present(indent)) string = string // nl // indent string = string // "}" string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("properties", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("totalCharge", indent) // json_value(nint(mol%charge)) if (mol%uhf > 0) then string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("totalSpinMultiplicity", indent) // json_value(mol%uhf + 1) end if if (present(indent)) string = string // nl // indent string = string // "}" if (allocated(mol%bond)) then string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("bonds", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("connections", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 3) string = string // json_key("index", indent) // json_array([mol%bond(1:2, :) - 1], 3, indent) if (present(indent)) string = string // nl // repeat(indent, 2) string = string // "}" if (size(mol%bond, 1) > 2) then string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("order", indent) // json_array(mol%bond(3, :), 2, indent) if (present(indent)) string = string // nl // indent end if string = string // "}" end if if (any(mol%periodic)) then call dlat_to_cell(mol%lattice, cellpar) cellpar(1:3) = cellpar(1:3) * autoaa cellpar(4:6) = cellpar(4:6) * 180 / pi string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("unitCell", indent) // "{" if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("a", indent) // json_value(cellpar(1), "(es23.16)") string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("b", indent) // json_value(cellpar(2), "(es23.16)") string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("c", indent) // json_value(cellpar(3), "(es23.16)") string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("alpha", indent) // json_value(cellpar(4), "(es23.16)") string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("beta", indent) // json_value(cellpar(5), "(es23.16)") string = string // "," if (present(indent)) string = string // nl // repeat(indent, 2) string = string // json_key("gamma", indent) // json_value(cellpar(6), "(es23.16)") if (present(indent)) string = string // nl // indent string = string // "}" end if if (present(indent)) string = string // nl string = string // "}" end function json_string pure function json_array_int_1(array, depth, indent) result(string) integer, intent(in) :: array(:) integer, intent(in) :: depth character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string integer :: i, j string = "[" do i = 1, size(array) if (present(indent)) string = string // nl // repeat(indent, depth+1) string = string // json_value(array(i)) if (i /= size(array)) string = string // "," end do if (present(indent)) string = string // nl // repeat(indent, depth) string = string // "]" end function json_array_int_1 pure function json_array_real_1(array, depth, indent) result(string) real(wp), intent(in) :: array(:) integer, intent(in) :: depth character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string integer :: i, j string = "[" do i = 1, size(array) if (present(indent)) string = string // nl // repeat(indent, depth+1) string = string // json_value(array(i), '(es23.16)') if (i /= size(array)) string = string // "," end do if (present(indent)) string = string // nl // repeat(indent, depth) string = string // "]" end function json_array_real_1 pure function json_array_char_1(array, depth, indent) result(string) character(len=*), intent(in) :: array(:) integer, intent(in) :: depth character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string integer :: i, j string = "[" do i = 1, size(array) if (present(indent)) string = string // nl // repeat(indent, depth+1) string = string // json_value(trim(array(i))) if (i /= size(array)) string = string // "," end do if (present(indent)) string = string // nl // repeat(indent, depth) string = string // "]" end function json_array_char_1 pure function json_key(key, indent) result(string) character(len=*), intent(in) :: key character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string if (present(indent)) then string = json_value(key) // ": " else string = json_value(key) // ":" end if end function json_key pure function json_value_char(val) result(string) character(len=*), intent(in) :: val character(len=:), allocatable :: string string = """" // val // """" end function json_value_char pure function json_value_real(val, format) result(str) real(wp), intent(in) :: val character(len=*), intent(in) :: format character(len=:), allocatable :: str character(len=128) :: buffer integer :: stat write(buffer, format, iostat=stat) val if (stat == 0) then str = trim(buffer) else str = """*""" end if end function json_value_real pure function json_value_int(val) result(string) integer, intent(in) :: val character(len=:), allocatable :: string integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos integer :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] if (val == 0) then string = numbers(0) return end if n = abs(val) buffer = "" pos = buffer_len + 1 do while (n > 0) pos = pos - 1 buffer(pos:pos) = numbers(mod(n, 10)) n = n/10 end do if (val < 0) then pos = pos - 1 buffer(pos:pos) = '-' end if string = buffer(pos:) end function json_value_int !> Convert direct lattice to cell parameters pure subroutine dlat_to_cell(lattice,cellpar) implicit none real(wp),intent(in) :: lattice(3,3) !< direct lattice real(wp),intent(out) :: cellpar(6) !< cell parameters associate( alen => cellpar(1), blen => cellpar(2), clen => cellpar(3), & & alp => cellpar(4), bet => cellpar(5), gam => cellpar(6) ) alen = norm2(lattice(:,1)) blen = norm2(lattice(:,2)) clen = norm2(lattice(:,3)) alp = acos(dot_product(lattice(:,2),lattice(:,3))/(blen*clen)) bet = acos(dot_product(lattice(:,1),lattice(:,3))/(alen*clen)) gam = acos(dot_product(lattice(:,1),lattice(:,2))/(alen*blen)) end associate end subroutine dlat_to_cell end module mctc_io_write_cjson mctc-lib-0.3.2/src/mctc/io/write/ctfile.f90000066400000000000000000000075271466406626700203060ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_ctfile use mctc_env_accuracy, only : wp use mctc_io_convert, only : autoaa use mctc_io_structure, only : structure_type implicit none private public :: write_molfile, write_sdf contains subroutine write_sdf(self, unit, energy, gnorm) class(structure_type), intent(in) :: self integer, intent(in) :: unit real(wp), intent(in), optional :: energy real(wp), intent(in), optional :: gnorm !type(tb_buffer) :: sd_values character(len=:), allocatable :: line character(len=*), parameter :: sd_format = & & '("> <", a, ">", /, f20.12, /)' call write_molfile(self, unit) ! sd_values = self%info ! call sd_values%reset ! do while(sd_values%next()) ! call sd_values%getline(line) ! write(unit, '(a)') line ! enddo if (present(energy)) then write(unit, sd_format) "total energy / Eh", energy endif if (present(gnorm)) then write(unit, sd_format) "gradient norm / Eh/a0", gnorm endif write(unit, '("$$$$")') end subroutine write_sdf subroutine write_molfile(self, unit, comment_line) class(structure_type), intent(in) :: self integer, intent(in) :: unit character(len=*), intent(in), optional :: comment_line integer, parameter :: list4(4) = 0 integer :: iatom, ibond, iatoms(3), list12(12) logical :: has_sdf_data integer, parameter :: charge_to_ccc(-3:3) = [7, 6, 5, 0, 3, 2, 1] character(len=8) :: date character(len=10) :: time call date_and_time(date, time) if (present(comment_line)) then write(unit, '(a)') comment_line else if (allocated(self%comment)) then write(unit, '(a)') self%comment else write(unit, '(a)') end if end if write(unit, '(2x, 3x, 5x, 3a2, a4, "3D")') & & date(5:6), date(7:8), date(3:4), time(:4) write(unit, '(a)') write(unit, '(3i3, 3x, 2i3, 12x, i3, 1x, a5)') & & self%nat, self%nbd, 0, 0, 0, 999, 'V2000' has_sdf_data = allocated(self%sdf) do iatom = 1, self%nat if (has_sdf_data) then list12 = [self%sdf(iatom)%isotope, 0, 0, 0, 0, self%sdf(iatom)%valence, & & 0, 0, 0, 0, 0, 0] else list12 = 0 endif write(unit, '(3f10.4, 1x, a3, i2, 11i3)') & & self%xyz(:, iatom)*autoaa, self%sym(self%id(iatom)), list12 enddo if (self%nbd > 0) then if (size(self%bond, 1) > 2) then do ibond = 1, self%nbd write(unit, '(7i3)') self%bond(:3, ibond), list4 end do else do ibond = 1, self%nbd write(unit, '(7i3)') self%bond(:2, ibond), 1, list4 end do end if end if if (has_sdf_data) then if (sum(self%sdf%charge) /= nint(self%charge)) then write(unit, '(a, *(i3, 1x, i3, 1x, i3))') "M CHG", 1, 1, nint(self%charge) else do iatom = 1, self%nat if (self%sdf(iatom)%charge /= 0) then write(unit, '(a, *(i3, 1x, i3, 1x, i3))') & & "M CHG", 1, iatom, self%sdf(iatom)%charge end if end do end if else if (nint(self%charge) /= 0) then write(unit, '(a, *(i3, 1x, i3, 1x, i3))') "M CHG", 1, 1, nint(self%charge) end if end if write(unit, '(a)') "M END" end subroutine write_molfile end module mctc_io_write_ctfile mctc-lib-0.3.2/src/mctc/io/write/gaussian.f90000066400000000000000000000022151466406626700206370ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_gaussian use mctc_env_accuracy, only : wp use mctc_io_structure, only : structure_type implicit none private public :: write_gaussian_external contains subroutine write_gaussian_external(mol, unit) type(structure_type), intent(in) :: mol integer, intent(in) :: unit integer :: iat write(unit, '(4i10)') mol%nat, 1, nint(mol%charge), mol%uhf do iat = 1, mol%nat write(unit, '(i10,4f20.12)') mol%num(mol%id(iat)), mol%xyz(:, iat), 0.0_wp end do end subroutine write_gaussian_external end module mctc_io_write_gaussian mctc-lib-0.3.2/src/mctc/io/write/genformat.f90000066400000000000000000000052401466406626700210100ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_genformat use mctc_env_accuracy, only : wp use mctc_io_constants, only : pi use mctc_io_convert, only : autoaa use mctc_io_math, only : matinv_3x3 use mctc_io_symbols, only : to_symbol use mctc_io_structure, only : structure_type implicit none private public :: write_genformat contains subroutine write_genformat(mol, unit) class(structure_type), intent(in) :: mol integer, intent(in) :: unit integer :: iat, izp real(wp), parameter :: zero3(3) = 0.0_wp real(wp), allocatable :: inv_lat(:, :) real(wp), allocatable :: abc(:, :) logical :: helical helical = .false. write(unit, '(i0, 1x)', advance='no') mol%nat if (.not.any(mol%periodic)) then write(unit, '("C")') ! cluster else helical = count(mol%periodic) == 1 .and. mol%periodic(3) .and. size(mol%lattice, 2) == 1 if (helical) then write(unit, '("H")') ! helical else if (mol%info%cartesian) then write(unit, '("S")') ! supercell else write(unit, '("F")') ! fractional endif end if endif do izp = 1, mol%nid write(unit, '(1x, a)', advance='no') trim(mol%sym(izp)) enddo write(unit, '(a)') if (.not.any(mol%periodic) .or. mol%info%cartesian) then ! now write the cartesian coordinates do iat = 1, mol%nat write(unit, '(2i5, 3es24.14)') iat, mol%id(iat), mol%xyz(:, iat)*autoaa enddo else inv_lat = matinv_3x3(mol%lattice) abc = matmul(inv_lat, mol%xyz) ! now write the fractional coordinates do iat = 1, mol%nat write(unit, '(2i5, 3es24.15)') iat, mol%id(iat), abc(:, iat) enddo endif if (any(mol%periodic)) then write(unit, '(3f20.14)') zero3 ! write the lattice parameters if (helical) then write(unit, '(2f20.14,1x,i0)') & & mol%lattice(1, 1)*autoaa, mol%lattice(2, 1)*180.0_wp/pi, nint(mol%lattice(3, 1)) else write(unit, '(3f20.14)') mol%lattice(:, :)*autoaa end if endif end subroutine write_genformat end module mctc_io_write_genformat mctc-lib-0.3.2/src/mctc/io/write/meson.build000066400000000000000000000014031466406626700206450ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. srcs += files( 'aims.f90', 'cjson.f90', 'ctfile.f90', 'gaussian.f90', 'genformat.f90', 'pdb.f90', 'qchem.f90', 'qcschema.f90', 'turbomole.f90', 'vasp.f90', 'xyz.f90', ) mctc-lib-0.3.2/src/mctc/io/write/pdb.f90000066400000000000000000000066141466406626700176010ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_pdb use mctc_env_accuracy, only : wp use mctc_io_convert, only : autoaa use mctc_io_structure, only : structure_type implicit none private public :: write_pdb contains subroutine write_pdb(mol, unit, number) type(structure_type), intent(in) :: mol integer, intent(in) :: unit integer, intent(in), optional :: number character(len=6) :: w1 character(len=4) :: sym character(len=2) :: a_charge character(len=1) :: last_chain logical :: last_het integer :: offset, iat, jat real(wp) :: xyz(3) character(len=*), parameter :: pdb_format = & & '(a6,i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,3f8.3,2f6.2,6x,a4,a2,a2)' if (present(number)) write(unit, '("MODEL ",4x,i4)') number if (allocated(mol%pdb)) then offset = 0 last_chain = mol%pdb(1)%chains last_het = mol%pdb(1)%het do iat = 1, mol%nat ! handle the terminator if (mol%pdb(iat)%het .neqv. last_het) then write(unit, '("TER ",i5,6x,a3,1x,a1,i4)') iat + offset, & & mol%pdb(iat-1)%residue, last_chain, mol%pdb(iat)%residue_number last_het = .not.last_het last_chain = mol%pdb(iat)%chains offset = offset+1 else if (mol%pdb(iat)%chains /= last_chain) then write(unit, '("TER ",i5,6x,a3,1x,a1,i4)') iat + offset, & & mol%pdb(iat-1)%residue, last_chain, mol%pdb(iat)%residue_number last_chain = mol%pdb(iat)%chains offset = offset+1 endif jat = iat + offset if (mol%pdb(iat)%het) then w1 = "HETATM" else w1 = "ATOM " endif sym = adjustr(mol%sym(mol%id(iat))(1:2)) xyz = mol%xyz(:,iat) * autoaa if (mol%pdb(iat)%charge < 0) then write(a_charge, '(i1,"-")') abs(mol%pdb(iat)%charge) else if (mol%pdb(iat)%charge > 0) then write(a_charge, '(i1,"+")') abs(mol%pdb(iat)%charge) else a_charge = ' ' endif write(unit, pdb_format) & & w1, jat, mol%pdb(iat)%name, mol%pdb(iat)%loc, & & mol%pdb(iat)%residue, mol%pdb(iat)%chains, mol%pdb(iat)%residue_number, & & mol%pdb(iat)%code, xyz, 1.0_wp, 0.0_wp, mol%pdb(iat)%segid, & & sym, a_charge enddo else do iat = 1, mol%nat w1 = "HETATM" sym = adjustr(mol%sym(mol%id(iat))(1:2)) xyz = mol%xyz(:,iat) * autoaa a_charge = ' ' write(unit, pdb_format) & & w1, iat, sym, " ", & & "UNK", "A", 1, " ", xyz, 1.0_wp, 0.0_wp, " ", & & sym, " " enddo end if if (present(number)) then write(unit, '("ENDMDL")') else write(unit, '("END")') endif end subroutine write_pdb end module mctc_io_write_pdb mctc-lib-0.3.2/src/mctc/io/write/qchem.f90000066400000000000000000000030721466406626700201240ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_qchem use mctc_env_accuracy, only : wp use mctc_io_convert, only : autoaa use mctc_io_structure, only : structure_type implicit none private public :: write_qchem contains subroutine write_qchem(self, unit) !> Instance of the molecular structure data class(structure_type), intent(in) :: self !> File handle integer, intent(in) :: unit integer :: iat logical :: expo write(unit, '(a)') "$molecule" write(unit, '(*(1x, i0))') nint(self%charge), self%uhf + 1 expo = maxval(self%xyz) > 1.0e+5 .or. minval(self%xyz) < -1.0e+5 if (expo) then do iat = 1, self%nat write(unit, '(a, 1x, 3es24.14)') & self%sym(self%id(iat)), self%xyz(:, iat) * autoaa end do else do iat = 1, self%nat write(unit, '(a, 1x, 3f24.14)') & self%sym(self%id(iat)), self%xyz(:, iat) * autoaa end do end if write(unit, '(a)') "$end" end subroutine write_qchem end module mctc_io_write_qchem mctc-lib-0.3.2/src/mctc/io/write/qcschema.f90000066400000000000000000000200311466406626700206050ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_qcschema use mctc_env_accuracy, only : wp use mctc_io_structure, only : structure_type use mctc_version, only : get_mctc_version implicit none private public :: write_qcschema interface json_value module procedure :: json_value_char module procedure :: json_value_int module procedure :: json_value_real end interface json_value interface json_array module procedure :: json_array_char_1 module procedure :: json_array_int_1 module procedure :: json_array_real_1 end interface json_array character(len=*), parameter :: nl = new_line('a') contains subroutine write_qcschema(mol, unit) type(structure_type), intent(in) :: mol integer, intent(in) :: unit write(unit, '(a)') json_string(mol, " ") end subroutine write_qcschema pure function json_string(mol, indent) result(string) type(structure_type), intent(in) :: mol character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string string = "{" if (present(indent)) string = string // nl // indent string = string // json_key("schema_version", indent) // json_value(2) string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("schema_name", indent) // json_value("qcschema_molecule") string = string // "," block character(len=:), allocatable :: version call get_mctc_version(string=version) if (present(indent)) string = string // nl // indent string = string // json_key("provenance", indent) // "{" if (present(indent)) string = string // nl // indent // indent string = string // json_key("creator", indent) // json_value("mctc-lib") string = string // "," if (present(indent)) string = string // nl // indent // indent string = string // json_key("version", indent) // json_value(version) string = string // "," if (present(indent)) string = string // nl // indent // indent string = string // json_key("routine", indent) // & & json_value("mctc_io_write_qcschema::write_qcschema") if (present(indent)) string = string // nl // indent string = string // "}" end block if (allocated(mol%comment)) then string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("comment", indent) // json_value(mol%comment) end if string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("symbols", indent) // json_array(mol%sym(mol%id), indent) string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("atomic_numbers", indent) // & & json_array(mol%num(mol%id), indent) string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("geometry", indent) // json_array([mol%xyz], indent) string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("molecular_charge", indent) // json_value(nint(mol%charge)) if (mol%uhf > 0) then string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("molecular_multiplicity", indent) // json_value(mol%uhf+1) end if if (allocated(mol%bond)) then string = string // "," if (present(indent)) string = string // nl // indent string = string // json_key("connectivity", indent) // "[" block integer :: i do i = 1, mol%nbd if (present(indent)) string = string // nl // indent // indent string = string // "[" // json_value(mol%bond(1, i)-1) // "," // & & json_value(mol%bond(2, i)-1) // "," if (size(mol%bond, 1) > 2) then string = string // json_value(mol%bond(3, i)) // "]" else string = string // json_value(1) // "]" end if if (i /= mol%nbd) string = string // "," end do end block if (present(indent)) string = string // nl // indent string = string // "]" end if if (present(indent)) string = string // nl string = string // "}" end function json_string pure function json_array_int_1(array, indent) result(string) integer, intent(in) :: array(:) character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string integer :: i, j string = "[" do i = 1, size(array) if (present(indent)) string = string // nl // indent // indent string = string // json_value(array(i)) if (i /= size(array)) string = string // "," end do if (present(indent)) string = string // nl // indent string = string // "]" end function json_array_int_1 pure function json_array_real_1(array, indent) result(string) real(wp), intent(in) :: array(:) character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string integer :: i, j string = "[" do i = 1, size(array) if (present(indent)) string = string // nl // indent // indent string = string // json_value(array(i), '(es23.16)') if (i /= size(array)) string = string // "," end do if (present(indent)) string = string // nl // indent string = string // "]" end function json_array_real_1 pure function json_array_char_1(array, indent) result(string) character(len=*), intent(in) :: array(:) character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string integer :: i, j string = "[" do i = 1, size(array) if (present(indent)) string = string // nl // indent // indent string = string // json_value(trim(array(i))) if (i /= size(array)) string = string // "," end do if (present(indent)) string = string // nl // indent string = string // "]" end function json_array_char_1 pure function json_key(key, indent) result(string) character(len=*), intent(in) :: key character(len=*), intent(in), optional :: indent character(len=:), allocatable :: string if (present(indent)) then string = json_value(key) // ": " else string = json_value(key) // ":" end if end function json_key pure function json_value_char(val) result(string) character(len=*), intent(in) :: val character(len=:), allocatable :: string string = """" // val // """" end function json_value_char pure function json_value_real(val, format) result(str) real(wp), intent(in) :: val character(len=*), intent(in) :: format character(len=:), allocatable :: str character(len=128) :: buffer integer :: stat write(buffer, format, iostat=stat) val if (stat == 0) then str = trim(buffer) else str = """*""" end if end function json_value_real pure function json_value_int(val) result(string) integer, intent(in) :: val character(len=:), allocatable :: string integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos integer :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] if (val == 0) then string = numbers(0) return end if n = abs(val) buffer = "" pos = buffer_len + 1 do while (n > 0) pos = pos - 1 buffer(pos:pos) = numbers(mod(n, 10)) n = n/10 end do if (val < 0) then pos = pos - 1 buffer(pos:pos) = '-' end if string = buffer(pos:) end function json_value_int end module mctc_io_write_qcschema mctc-lib-0.3.2/src/mctc/io/write/turbomole.f90000066400000000000000000000044121466406626700210360ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_turbomole use mctc_env_accuracy, only : wp use mctc_io_structure, only : structure_type use mctc_io_convert, only : autoaa implicit none private public :: write_coord contains subroutine write_coord(mol, unit) class(structure_type), intent(in) :: mol integer, intent(in) :: unit integer :: iat, ilt, npbc logical :: expo real(wp) :: conv_fac logical :: angs angs = mol%info%angs_coord conv_fac = 1.0_wp if (angs) conv_fac = autoaa if (angs) then write(unit, '(a)') "$coord angs" else write(unit, '(a)') "$coord" end if expo = maxval(mol%xyz) > 1.0e+5 .or. minval(mol%xyz) < -1.0e+5 if (expo) then do iat = 1, mol%nat write(unit, '(3es24.14, 6x, a)') mol%xyz(:, iat) * conv_fac, & trim(mol%sym(mol%id(iat))) end do else do iat = 1, mol%nat write(unit, '(3f24.14, 6x, a)') mol%xyz(:, iat) * conv_fac, & trim(mol%sym(mol%id(iat))) end do end if if (any([nint(mol%charge), mol%uhf] /= 0)) then write(unit, '(a, *(1x, a, "=", i0))') & "$eht", "charge", nint(mol%charge), "unpaired", mol%uhf end if if (any(mol%periodic)) then write(unit, '(a, 1x, i0)') "$periodic", count(mol%periodic) npbc = count(mol%periodic) if (size(mol%lattice, 2) == 3) then if (angs) then write(unit, '(a)') "$lattice angs" else write(unit, '(a)') "$lattice bohr" end if do ilt = 1, npbc write(unit, '(3f20.14)') mol%lattice(:npbc, ilt) * conv_fac end do end if end if write(unit, '(a)') "$end" end subroutine write_coord end module mctc_io_write_turbomolemctc-lib-0.3.2/src/mctc/io/write/vasp.f90000066400000000000000000000060101466406626700177730ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_vasp use mctc_env_accuracy, only : wp use mctc_io_convert, only : autoaa use mctc_io_math, only : matinv_3x3 use mctc_io_structure, only : structure_type implicit none private public :: write_vasp contains subroutine write_vasp(self, unit, comment_line) class(structure_type), intent(in) :: self integer, intent(in) :: unit character(len=*), intent(in), optional :: comment_line integer :: i, j, izp integer, allocatable :: kinds(:), species(:) real(wp), allocatable :: inv_lat(:, :) real(wp), allocatable :: abc(:, :) allocate(species(self%nat)) allocate(kinds(self%nat), source=1) j = 0 izp = 0 do i = 1, self%nat if (izp.eq.self%id(i)) then kinds(j) = kinds(j)+1 else j = j+1 izp = self%id(i) species(j) = self%id(i) end if end do ! use vasp 5.x format if (present(comment_line)) then write(unit, '(a)') comment_line else if (allocated(self%comment)) then write(unit, '(a)') self%comment else write(unit, '(a)') end if end if ! scaling factor for lattice parameters is always one write(unit, '(f20.14)') self%info%scale ! write the lattice parameters if (any(self%periodic)) then if (size(self%lattice, 2) == 3) then write(unit, '(3f20.14)') self%lattice else write(unit, '(3f20.14)') spread(0.0_wp, 1, 9) end if else write(unit, '(3f20.14)') spread(0.0_wp, 1, 9) end if do i = 1, j write(unit, '(1x, a)', advance='no') self%sym(species(i)) end do write(unit, '(a)') ! write the count of the consecutive atom types do i = 1, j write(unit, '(1x, i0)', advance='no') kinds(i) end do write(unit, '(a)') deallocate(kinds, species) if (self%info%selective) write(unit, '("Selective")') ! we write cartesian coordinates if (any(shape(self%lattice) /= [3, 3]) .or. self%info%cartesian) then write(unit, '("Cartesian")') ! now write the cartesian coordinates do i = 1, self%nat write(unit, '(3f20.14)') self%xyz(:, i)*autoaa/self%info%scale end do else write(unit, '("Direct")') inv_lat = matinv_3x3(self%lattice) abc = matmul(inv_lat, self%xyz) ! now write the fractional coordinates do i = 1, self%nat write(unit, '(3f20.14)') abc(:, i) end do end if end subroutine write_vasp end module mctc_io_write_vasp mctc-lib-0.3.2/src/mctc/io/write/xyz.f90000066400000000000000000000032231466406626700176570ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module mctc_io_write_xyz use mctc_io_convert, only : autoaa use mctc_io_structure, only : structure_type implicit none private public :: write_xyz contains subroutine write_xyz(self, unit, comment_line) class(structure_type), intent(in) :: self integer, intent(in) :: unit character(len=*), intent(in), optional :: comment_line integer :: iat logical :: expo write(unit, '(i0)') self%nat if (present(comment_line)) then write(unit, '(a)') comment_line else if (allocated(self%comment)) then write(unit, '(a)') self%comment else write(unit, '(a)') end if end if expo = maxval(self%xyz) > 1.0e+5 .or. minval(self%xyz) < -1.0e+5 if (expo) then do iat = 1, self%nat write(unit, '(a4, 1x, 3es24.14)') & & self%sym(self%id(iat)), self%xyz(:, iat)*autoaa enddo else do iat = 1, self%nat write(unit, '(a4, 1x, 3f24.14)') & & self%sym(self%id(iat)), self%xyz(:, iat)*autoaa enddo end if end subroutine write_xyz end module mctc_io_write_xyz mctc-lib-0.3.2/src/mctc/meson.build000066400000000000000000000012331466406626700171050ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. subdir('env') subdir('io') srcs += files( 'env.f90', 'io.f90', 'version.F90', ) mctc-lib-0.3.2/src/mctc/version.F90000066400000000000000000000044171466406626700167170ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. #include "mctc/defs.h" module mctc_version implicit none private public :: mctc_version_string, mctc_version_compact public :: get_mctc_version, get_mctc_feature !> String representation of the mctc-lib version character(len=*), parameter :: mctc_version_string = "0.3.2" !> Numeric representation of the mctc-lib version integer, parameter :: mctc_version_compact(3) = [0, 3, 2] !> With support for JSON logical, parameter :: mctc_with_json = 0 /= WITH_JSON contains !> Getter function to retrieve mctc-lib version pure subroutine get_mctc_version(major, minor, patch, string) !> Major version number of the mctc-lib version integer, intent(out), optional :: major !> Minor version number of the mctc-lib version integer, intent(out), optional :: minor !> Patch version number of the mctc-lib version integer, intent(out), optional :: patch !> String representation of the mctc-lib version character(len=:), allocatable, intent(out), optional :: string if (present(major)) then major = mctc_version_compact(1) end if if (present(minor)) then minor = mctc_version_compact(2) end if if (present(patch)) then patch = mctc_version_compact(3) end if if (present(string)) then string = mctc_version_string end if end subroutine get_mctc_version pure function get_mctc_feature(feature) result(has_feature) !> Feature name character(len=*), intent(in) :: feature !> Whether the feature is enabled logical :: has_feature select case(feature) case("json") has_feature = mctc_with_json case default has_feature = .false. end select end function get_mctc_feature end module mctc_version mctc-lib-0.3.2/src/meson.build000066400000000000000000000011231466406626700161550ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. subdir('mctc') mctc-lib-0.3.2/subprojects/000077500000000000000000000000001466406626700155725ustar00rootroot00000000000000mctc-lib-0.3.2/subprojects/.gitignore000066400000000000000000000000401466406626700175540ustar00rootroot00000000000000/packagecache/ /json-fortran-*/ mctc-lib-0.3.2/subprojects/json-fortran-8.2.5.wrap000066400000000000000000000004321466406626700215560ustar00rootroot00000000000000[wrap-file] directory = json-fortran-8.2.5 source_url = https://github.com/jacobwilliams/json-fortran/archive/refs/tags/8.2.5.tar.gz source_filename = 8.2.5.tar.gz source_hash = 16eec827f64340c226ba9a8463f001901d469bc400a1e88b849f258f9ef0d100 patch_directory = json-fortran-8.2.5 mctc-lib-0.3.2/subprojects/packagefiles/000077500000000000000000000000001466406626700202105ustar00rootroot00000000000000mctc-lib-0.3.2/subprojects/packagefiles/json-fortran-8.2.5/000077500000000000000000000000001466406626700233025ustar00rootroot00000000000000mctc-lib-0.3.2/subprojects/packagefiles/json-fortran-8.2.5/meson.build000066400000000000000000000013751466406626700254520ustar00rootroot00000000000000project( 'jsonfortran', 'Fortran', version: files('.VERSION'), ) fc = meson.get_compiler('fortran') if fc.get_id() == 'intel-cl' add_project_arguments( '-fpp', language: 'fortran', ) endif jsonfortran_lib = library( meson.project_name(), sources: files( 'src/json_kinds.F90', 'src/json_parameters.F90', 'src/json_string_utilities.F90', 'src/json_value_module.F90', 'src/json_file_module.F90', 'src/json_module.F90', ), include_directories: include_directories('src'), ) jsonfortran_dep = declare_dependency( link_with: jsonfortran_lib, include_directories: jsonfortran_lib.private_dir_include(), ) install_data( 'LICENSE', install_dir: get_option('datadir')/'licenses'/'mctc-lib'/meson.project_name() ) mctc-lib-0.3.2/test/000077500000000000000000000000001466406626700142065ustar00rootroot00000000000000mctc-lib-0.3.2/test/CMakeLists.txt000066400000000000000000000026161466406626700167530ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # Unit testing set( tests "math" "read" "read-aims" "read-cjson" "read-ctfile" "read-gaussian" "read-genformat" "read-pdb" "read-qchem" "read-qcschema" "read-turbomole" "read-vasp" "read-xyz" "symbols" "write" "write-aims" "write-cjson" "write-ctfile" "write-gaussian" "write-genformat" "write-pdb" "write-qchem" "write-turbomole" "write-vasp" "write-xyz" ) set( test-srcs "main.f90" "testsuite_structure.f90" ) foreach(t IN LISTS tests) string(MAKE_C_IDENTIFIER ${t} t) list(APPEND test-srcs "test_${t}.f90") endforeach() add_executable( "${PROJECT_NAME}-tester" "${test-srcs}" ) target_link_libraries( "${PROJECT_NAME}-tester" PRIVATE "${PROJECT_NAME}-lib" ) foreach(t IN LISTS tests) add_test("${PROJECT_NAME}/${t}" "${PROJECT_NAME}-tester" "${t}") endforeach() mctc-lib-0.3.2/test/main.f90000066400000000000000000000116441466406626700154600ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. !> Driver for unit testing program tester use, intrinsic :: iso_fortran_env, only : error_unit use mctc_env_system, only : get_argument use mctc_env_testing, only : run_testsuite, new_testsuite, testsuite_type, & & select_suite, run_selected use test_math, only : collect_math use test_read, only : collect_read use test_read_aims, only : collect_read_aims use test_read_cjson, only : collect_read_cjson use test_read_ctfile, only : collect_read_ctfile use test_read_gaussian, only : collect_read_gaussian use test_read_genformat, only : collect_read_genformat use test_read_pdb, only : collect_read_pdb use test_read_qchem, only : collect_read_qchem use test_read_qcschema, only : collect_read_qcschema use test_read_turbomole, only : collect_read_turbomole use test_read_vasp, only : collect_read_vasp use test_read_xyz, only : collect_read_xyz use test_symbols, only : collect_symbols use test_write, only : collect_write use test_write_aims, only : collect_write_aims use test_write_cjson, only : collect_write_cjson use test_write_ctfile, only : collect_write_ctfile use test_write_gaussian, only : collect_write_gaussian use test_write_genformat, only : collect_write_genformat use test_write_pdb, only : collect_write_pdb use test_write_qchem, only : collect_write_qchem use test_write_turbomole, only : collect_write_turbomole use test_write_vasp, only : collect_write_vasp use test_write_xyz, only : collect_write_xyz implicit none integer :: stat, is character(len=:), allocatable :: suite_name, test_name type(testsuite_type), allocatable :: testsuites(:) character(len=*), parameter :: fmt = '("#", *(1x, a))' stat = 0 testsuites = [ & & new_testsuite("math", collect_math), & & new_testsuite("symbols", collect_symbols), & & new_testsuite("read", collect_read), & & new_testsuite("read-aims", collect_read_aims), & & new_testsuite("read-cjson", collect_read_cjson), & & new_testsuite("read-ctfile", collect_read_ctfile), & & new_testsuite("read-gaussian", collect_read_gaussian), & & new_testsuite("read-genformat", collect_read_genformat), & & new_testsuite("read-pdb", collect_read_pdb), & & new_testsuite("read-qchem", collect_read_qchem), & & new_testsuite("read-qcschema", collect_read_qcschema), & & new_testsuite("read-turbomole", collect_read_turbomole), & & new_testsuite("read-vasp", collect_read_vasp), & & new_testsuite("read-xyz", collect_read_xyz), & & new_testsuite("write", collect_write), & & new_testsuite("write-aims", collect_write_aims), & & new_testsuite("write-cjson", collect_write_cjson), & & new_testsuite("write-ctfile", collect_write_ctfile), & & new_testsuite("write-gaussian", collect_write_gaussian), & & new_testsuite("write-genformat", collect_write_genformat), & & new_testsuite("write-pdb", collect_write_pdb), & & new_testsuite("write-qchem", collect_write_qchem), & & new_testsuite("write-turbomole", collect_write_turbomole), & & new_testsuite("write-vasp", collect_write_vasp), & & new_testsuite("write-xyz", collect_write_xyz) & & ] call get_argument(1, suite_name) call get_argument(2, test_name) if (allocated(suite_name)) then is = select_suite(testsuites, suite_name) if (is > 0 .and. is <= size(testsuites)) then if (allocated(test_name)) then write(error_unit, fmt) "Suite:", testsuites(is)%name call run_selected(testsuites(is)%collect, test_name, error_unit, stat) if (stat < 0) then error stop 1 end if else write(error_unit, fmt) "Testing:", testsuites(is)%name call run_testsuite(testsuites(is)%collect, error_unit, stat) end if else write(error_unit, fmt) "Available testsuites" do is = 1, size(testsuites) write(error_unit, fmt) "-", testsuites(is)%name end do error stop 1 end if else do is = 1, size(testsuites) write(error_unit, fmt) "Testing:", testsuites(is)%name call run_testsuite(testsuites(is)%collect, error_unit, stat) end do end if if (stat > 0) then write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" error stop 1 end if end program tester mctc-lib-0.3.2/test/meson.build000066400000000000000000000024161466406626700163530ustar00rootroot00000000000000# This file is part of mctc-lib. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. tests = [ 'math', 'read', 'read-aims', 'read-cjson', 'read-ctfile', 'read-gaussian', 'read-genformat', 'read-pdb', 'read-qchem', 'read-qcschema', 'read-turbomole', 'read-vasp', 'read-xyz', 'symbols', 'write', 'write-aims', 'write-cjson', 'write-ctfile', 'write-gaussian', 'write-genformat', 'write-pdb', 'write-qchem', 'write-turbomole', 'write-vasp', 'write-xyz', ] test_srcs = files( 'main.f90', 'testsuite_structure.f90', ) foreach t : tests test_srcs += files('test_@0@.f90'.format(t.underscorify())) endforeach tester = executable( 'tester', sources: test_srcs, dependencies: mctc_dep, ) foreach t : tests test(t, tester, args: t) endforeach mctc-lib-0.3.2/test/test_math.f90000066400000000000000000000110301466406626700165110ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_math use mctc_env_accuracy, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_math implicit none private public :: collect_math real(wp), parameter :: thr = sqrt(epsilon(1.0_wp)) contains !> Collect all exported unit tests subroutine collect_math(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid-eigval", test_eigval), & & new_unittest("valid-eigvec", test_eigvec), & & new_unittest("valid-matdet", test_matdet), & & new_unittest("valid-matinv", test_matinv) & & ] end subroutine collect_math subroutine test_matdet(error) !> Error handling type(error_type), allocatable, intent(out) :: error real(wp) :: mat(3, 3), det mat = reshape(& & [2.0_wp, 1.0_wp, 3.0_wp, 1.0_wp, 3.0_wp, 0.0_wp, 3.0_wp, 0.0_wp, 4.0_wp], & & shape(mat)) det = matdet_3x3(mat) call check(error, det, -7.0_wp, thr=thr) end subroutine test_matdet subroutine test_matinv(error) !> Error handling type(error_type), allocatable, intent(out) :: error real(wp) :: mat(3, 3), inv(3, 3) mat = reshape(& & [2.0_wp, 1.0_wp, 3.0_wp, 1.0_wp, 3.0_wp, 0.0_wp, 3.0_wp, 0.0_wp, 4.0_wp], & & shape(mat)) inv = matinv_3x3(mat) mat = matmul(mat, inv) call check(error, mat(1, 1), 1.0_wp, thr=thr) if (allocated(error)) return call check(error, mat(2, 2), 1.0_wp, thr=thr) if (allocated(error)) return call check(error, mat(3, 3), 1.0_wp, thr=thr) if (allocated(error)) return call check(error, mat(1, 2), 0.0_wp, thr=thr) if (allocated(error)) return call check(error, mat(1, 3), 0.0_wp, thr=thr) if (allocated(error)) return call check(error, mat(2, 3), 0.0_wp, thr=thr) if (allocated(error)) return end subroutine test_matinv subroutine test_eigval(error) !> Error handling type(error_type), allocatable, intent(out) :: error real(wp) :: mat(3, 3), eval(3) mat = reshape(& & [2.0_wp, 1.0_wp, 3.0_wp, 1.0_wp, 3.0_wp, 0.0_wp, 3.0_wp, 0.0_wp, 4.0_wp], & & shape(mat)) call eigval_3x3(mat, eval) call check(error, eval(1),-0.3611775878183057_wp, thr=thr) if (allocated(error)) return call check(error, eval(2), 3.0909775466663136_wp, thr=thr) if (allocated(error)) return call check(error, eval(3), 6.2702000411519920_wp, thr=thr) if (allocated(error)) return end subroutine test_eigval subroutine test_eigvec(error) !> Error handling type(error_type), allocatable, intent(out) :: error real(wp) :: mat(3, 3), eval(3), evec(3, 3) mat = reshape(& & [2.0_wp, 1.0_wp, 3.0_wp, 1.0_wp, 3.0_wp, 0.0_wp, 3.0_wp, 0.0_wp, 4.0_wp], & & shape(mat)) call eigvec_3x3(mat, eval, evec) call check(error, eval(1),-0.3611775878183057_wp, thr=thr) if (allocated(error)) return call check(error, eval(2), 3.0909775466663136_wp, thr=thr) if (allocated(error)) return call check(error, eval(3), 6.2702000411519920_wp, thr=thr) if (allocated(error)) return call check(error, evec(1, 1), 0.80020375200069072_wp, thr=thr) if (allocated(error)) return call check(error, evec(2, 1),-0.23807244071268843_wp, thr=thr) if (allocated(error)) return call check(error, evec(3, 1),-0.55045024139982024_wp, thr=thr) if (allocated(error)) return call check(error, evec(1, 2), 0.08680581175113650_wp, thr=thr) if (allocated(error)) return call check(error, evec(2, 2), 0.95414544502416110_wp, thr=thr) if (allocated(error)) return call check(error, evec(3, 2),-0.28648075116117611_wp, thr=thr) if (allocated(error)) return call check(error, evec(1, 3), 0.59341276219023387_wp, thr=thr) if (allocated(error)) return call check(error, evec(2, 3), 0.18146069192182893_wp, thr=thr) if (allocated(error)) return call check(error, evec(3, 3), 0.78417683653434167_wp, thr=thr) if (allocated(error)) return end subroutine test_eigvec end module test_math mctc-lib-0.3.2/test/test_read.f90000066400000000000000000000622011466406626700165010ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read use mctc_env_accuracy, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read use mctc_io_structure, only : structure_type use mctc_io_filetype, only : get_filetype use mctc_version, only : get_mctc_feature implicit none private public :: collect_read contains !> Collect all exported unit tests subroutine collect_read(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid-cjson", test_cjson, should_fail=.not.get_mctc_feature("json")), & & new_unittest("valid-mol", test_mol), & & new_unittest("valid-sdf", test_sdf), & & new_unittest("valid-gen", test_gen), & & new_unittest("valid-pdb", test_pdb), & & new_unittest("valid-qchem", test_qchem), & & new_unittest("valid-qcschema", test_qcschema, should_fail=.not.get_mctc_feature("json")), & & new_unittest("valid-vasp", test_vasp), & & new_unittest("valid-coord", test_coord), & & new_unittest("valid-xyz", test_xyz) & & ] end subroutine collect_read subroutine test_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".mol" open(file=name, newunit=unit) write(unit, '(a)') & "", & " xtb 10012013503D", & "", & " 24 25 0 0 0 999 V2000", & " 1.0732 0.0489 -0.0757 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.5137 0.0126 -0.0758 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.3520 1.0959 -0.0753 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.6190 0.7303 -0.0755 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.5791 -0.6314 -0.0753 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.3013 -1.1026 -0.0752 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.9807 -2.4869 -0.0738 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.8253 -2.9004 -0.0758 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.1144 -3.3043 -0.0694 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 5.4517 -2.8562 -0.0724 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 6.3893 -3.6597 -0.0723 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 5.6624 -1.4768 -0.0749 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.0095 -0.9365 -0.0752 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.9206 -4.7409 -0.0616 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7340 1.0879 -0.0750 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7124 -0.4570 0.8234 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7124 -0.4558 -0.9755 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.9930 2.1176 -0.0748 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.7653 -1.7263 -0.0759 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.1486 -0.3218 0.8197 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.1480 -0.3208 -0.9695 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.8650 -5.0232 -0.0583 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.4023 -5.1592 0.8284 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.4002 -5.1693 -0.9478 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 1 0 0 0 0", & " 2 3 4 0 0 0 0", & " 3 4 4 0 0 0 0", & " 4 5 4 0 0 0 0", & " 2 6 1 0 0 0 0", & " 5 6 4 0 0 0 0", & " 6 7 1 0 0 0 0", & " 7 8 2 0 0 0 0", & " 7 9 1 0 0 0 0", & " 9 10 1 0 0 0 0", & " 10 11 2 0 0 0 0", & " 5 12 1 0 0 0 0", & " 10 12 1 0 0 0 0", & " 12 13 1 0 0 0 0", & " 9 14 1 0 0 0 0", & " 1 15 1 0 0 0 0", & " 1 16 1 0 0 0 0", & " 1 17 1 0 0 0 0", & " 3 18 1 0 0 0 0", & " 13 19 1 0 0 0 0", & " 13 20 1 0 0 0 0", & " 13 21 1 0 0 0 0", & " 14 22 1 0 0 0 0", & " 14 23 1 0 0 0 0", & " 14 24 1 0 0 0 0", & "M END" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_mol subroutine test_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".sdf" open(file=name, newunit=unit) write(unit, '(a)') & "", & " xtb 08072014173D", & "", & " 13 13 0 0 0 999 V2000", & " 1.4896 -2.2438 -0.0275 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.8475 -1.2058 -0.0075 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.4981 0.0466 0.2360 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7744 1.2240 0.2564 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5681 1.2354 0.0512 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.3469 -0.0099 -0.2052 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5125 -1.2225 -0.2193 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.5680 0.0344 0.3998 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.2958 2.1567 0.4406 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.0960 2.1819 0.0742 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.8599 0.0606 -1.1755 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -2.1168 -0.1374 0.5699 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.9728 -2.1202 -0.3930 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 2 0 0 0 0", & " 2 3 1 0 0 0 0", & " 3 4 2 0 0 0 0", & " 3 8 1 0 0 0 0", & " 4 5 1 0 0 0 0", & " 4 9 1 0 0 0 0", & " 5 6 1 0 0 0 0", & " 5 10 1 0 0 0 0", & " 6 7 1 0 0 0 0", & " 6 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & " 7 2 1 0 0 0 0", & " 7 13 1 0 0 0 0", & "M CHG 1 5 1", & "M END", & "> ", & "-18.421705869411", & "", & "> ", & "0.000695317397", & "", & "$$$$" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_sdf subroutine test_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".pdb" open(file=name, newunit=unit) write(unit, '(a)') & "HETATM 1 O HOH 1 -4.900 22.628 -5.720 1.00 0.00 O ", & "HETATM 2 O HOH 2 -3.391 28.399 -5.286 1.00 0.00 O ", & "HETATM 3 O HOH 3 -1.344 27.910 -2.140 1.00 0.00 O ", & "HETATM 4 O HOH 4 -3.412 29.606 -2.541 1.00 0.00 O ", & "HETATM 5 O HOH 5 -1.321 28.109 -8.687 1.00 0.00 O ", & "HETATM 6 O HOH 6 -3.810 29.129 -8.232 1.00 0.00 O ", & "HETATM 7 H HOH 0 -4.922 23.438 -5.175 1.00 0.00 H ", & "HETATM 8 H HOH 0 -5.691 22.647 -6.276 1.00 0.00 H ", & "HETATM 9 H HOH 0 -2.824 28.827 -5.944 1.00 0.00 H ", & "HETATM 10 H HOH 0 -4.277 28.836 -5.406 1.00 0.00 H ", & "HETATM 11 H HOH 0 -1.979 28.651 -2.242 1.00 0.00 H ", & "HETATM 12 H HOH 0 -1.885 27.145 -2.375 1.00 0.00 H ", & "HETATM 13 H HOH 0 -3.380 30.352 -3.142 1.00 0.00 H ", & "HETATM 14 H HOH 0 -4.045 28.971 -2.911 1.00 0.00 H ", & "HETATM 15 H HOH 0 -0.902 28.921 -8.995 1.00 0.00 H ", & "HETATM 16 H HOH 0 -2.254 28.344 -8.517 1.00 0.00 H ", & "HETATM 17 H HOH 0 -4.487 29.278 -7.546 1.00 0.00 H ", & "HETATM 18 H HOH 0 -3.960 29.804 -8.896 1.00 0.00 H ", & "END" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_pdb subroutine test_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".qchem" open(file=name, newunit=unit) write(unit, '(a)') & "$molecule", & " 0 1", & "O -4.900 22.628 -5.720", & "O -3.391 28.399 -5.286", & "O -1.344 27.910 -2.140", & "O -3.412 29.606 -2.541", & "O -1.321 28.109 -8.687", & "O -3.810 29.129 -8.232", & "H -4.922 23.438 -5.175", & "H -5.691 22.647 -6.276", & "H -2.824 28.827 -5.944", & "H -4.277 28.836 -5.406", & "H -1.979 28.651 -2.242", & "H -1.885 27.145 -2.375", & "H -3.380 30.352 -3.142", & "H -4.045 28.971 -2.911", & "H -0.902 28.921 -8.995", & "H -2.254 28.344 -8.517", & "H -4.487 29.278 -7.546", & "H -3.960 29.804 -8.896", & "$end" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_qchem subroutine test_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".gen" open(file=name, newunit=unit) write(unit, '(a)') & "25 C", & "C I H N", & " 1 1 1.0144755100E+00 4.6020000000E-04 -5.7394848000E-01", & " 2 1 -2.0032898000E-01 -4.5965000000E-04 1.1414560000E-01", & " 3 1 -2.0231545000E-01 -7.5279000000E-04 1.5088935800E+00", & " 4 1 9.9778745000E-01 -1.4728000000E-04 2.2196682500E+00", & " 5 1 2.2098457600E+00 7.7203000000E-04 1.5267653600E+00", & " 6 1 2.2204190100E+00 1.0915900000E-03 1.3029999000E-01", & " 7 2 -2.0632490900E+00 -1.7735200000E-03 2.5681651400E+00", & " 8 3 9.9055013000E-01 -3.9128000000E-04 3.3058222100E+00", & " 9 3 3.1477611200E+00 1.2445900000E-03 2.0779530500E+00", & " 10 3 3.1655004500E+00 1.8314400000E-03 -4.0749435000E-01", & " 11 3 1.0197382500E+00 6.8937000000E-04 -1.6618052000E+00", & " 12 3 -1.1377934900E+00 -9.4582000000E-04 -4.3447764000E-01", & " 13 4 -4.5879963100E+00 -1.7316200000E-03 4.0080783300E+00", & " 14 1 -5.4215082100E+00 1.0537153000E+00 3.4165937900E+00", & " 15 1 -5.1864905500E+00 -1.3318644400E+00 3.8317758400E+00", & " 16 1 -4.2778535800E+00 2.7405573000E-01 5.4173867200E+00", & " 17 3 -5.1820921200E+00 2.9428169000E-01 6.0466815900E+00", & " 18 3 -3.6095075800E+00 -4.9753141000E-01 5.8038290000E+00", & " 19 3 -3.7811344200E+00 1.2423401200E+00 5.5011568400E+00", & " 20 3 -6.4066973900E+00 1.1287638900E+00 3.9043224100E+00", & " 21 3 -4.9175136300E+00 2.0169453400E+00 3.5136058800E+00", & " 22 3 -5.5795960400E+00 8.4572812000E-01 2.3568167300E+00", & " 23 3 -6.1551031700E+00 -1.4245890400E+00 4.3488506700E+00", & " 24 3 -5.3462169300E+00 -1.5245333100E+00 2.7693575100E+00", & " 25 3 -4.5125813600E+00 -2.0930893200E+00 4.2288284200E+00" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_gen subroutine test_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".coord" open(file=name, newunit=unit) write(unit, '(a)') & "$coord frac", & " 0.00000000000000 0.00000000000000 0.00000000000000 mg", & " 0.50000000000000 0.50000000000000 0.50000000000000 o", & "$periodic 3", & "$cell", & " 5.798338236 5.798338236 5.798338236 60. 60. 60.", & "$end" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_coord subroutine test_vasp(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".poscar" open(file=name, newunit=unit) write(unit, '(a)') & "Na Cl ", & " 1.0000000000000000", & " 5.6405599999999998 0.0000000000000000 0.0000000000000000", & " 0.0000000000000000 5.6405599999999998 0.0000000000000000", & " 0.0000000000000000 0.0000000000000000 5.6405599999999998", & " 4 4", & "Cartesian", & " 0.0000000000000000 0.0000000000000000 0.0000000000000000", & " 0.0000000000000000 2.8202799999999999 2.8202799999999999", & " 2.8202799999999999 0.0000000000000000 2.8202799999999999", & " 2.8202799999999999 2.8202799999999999 0.0000000000000000", & " 2.8202799999999999 2.8202799999999999 2.8202799999999999", & " 2.8202799999999999 0.0000000000000000 0.0000000000000000", & " 0.0000000000000000 2.8202799999999999 0.0000000000000000", & " 0.0000000000000000 0.0000000000000000 2.8202799999999999" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_vasp subroutine test_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".xyz" open(file=name, newunit=unit) write(unit, '(a)') & "47", & "comment='Rivaroxaban (7)'", & "Cl 10.37060000 0.04000000 0.09340000", & "C 8.67250000 0.18330000 0.27690000", & "C 7.94790000 1.31690000 0.57310000", & "C 6.54940000 1.05420000 0.64450000", & "C 6.29630000 -0.25050000 0.40050000", & "S 7.66770000 -1.19010000 0.08600000", & "C 4.98660000 -0.91730000 0.38250000", & "O 4.86140000 -2.11520000 0.12170000", & "N 3.87770000 -0.10620000 0.64850000", & "C 2.53500000 -0.60710000 0.63610000", & "C 1.91560000 -0.48810000 -0.74950000", & "C 0.49590000 -1.00870000 -0.81480000", & "N -0.29810000 0.18230000 -0.67240000", & "C 0.49690000 1.30240000 -0.90140000", & "O 0.17750000 2.48080000 -0.97180000", & "O 1.80070000 0.90110000 -1.08790000", & "C -1.70220000 0.15010000 -0.43730000", & "C -2.43380000 1.33750000 -0.41950000", & "C -3.80920000 1.30600000 -0.18920000", & "C -4.44670000 0.08710000 0.02210000", & "C -3.72140000 -1.10060000 0.00540000", & "C -2.34600000 -1.06890000 -0.22480000", & "H -1.81830000 -2.01710000 -0.22660000", & "H -4.17020000 -2.06550000 0.21590000", & "N -5.86990000 0.05450000 0.26060000", & "C -6.65860000 -1.04450000 -0.12130000", & "O -6.28170000 -2.01920000 -0.77460000", & "C -8.10170000 -1.01510000 0.37010000", & "O -8.65500000 0.25530000 0.62130000", & "C -7.80770000 0.99800000 1.48360000", & "C -6.51980000 1.28190000 0.73820000", & "H -5.85050000 1.82830000 1.41150000", & "H -6.73450000 1.89190000 -0.14750000", & "H -8.31270000 1.93460000 1.73940000", & "H -7.63220000 0.44280000 2.41290000", & "H -8.72500000 -1.49560000 -0.39170000", & "H -8.16270000 -1.62590000 1.27870000", & "H -4.34420000 2.25050000 -0.20770000", & "H -1.99920000 2.31460000 -0.58100000", & "H 0.30010000 -1.74920000 -0.03410000", & "H 0.28380000 -1.44110000 -1.79930000", & "H 2.54530000 -0.98390000 -1.49690000", & "H 2.53380000 -1.65030000 0.97000000", & "H 1.97700000 -0.01220000 1.36770000", & "H 3.99640000 0.88090000 0.84660000", & "H 5.81840000 1.81990000 0.86610000", & "H 8.39390000 2.29070000 0.73180000" close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_xyz subroutine test_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".json" open(file=name, newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 2,', & ' "schema_name": "qcschema_molecule",', & ' "provenance": {', & ' "creator": "mctc-lib",', & ' "version": "0.2.3",', & ' "routine": "mctc_io_write_qcschema::write_qcschema"', & ' },', & ' "symbols": [', & ' "C", "N", "C", "N", "C", "C", "C", "O", "N", "C", "O", "N",', & ' "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H"', & ' ],', & ' "geometry": [', & ' 2.0280536328008760E+00, 9.2407587256767454E-02,-1.4305223630546618E-01,', & ' 4.7502035191684326E+00, 2.3810543955731494E-02,-1.4324120887654343E-01,', & ' 6.3343605825088858E+00, 2.0709504064354083E+00,-1.4229634602115726E-01,', & ' 8.7286430580574415E+00, 1.3800666865770403E+00,-1.4267429116331171E-01,', & ' 8.6532430021976250E+00,-1.1931728137816557E+00,-1.4229634602115726E-01,', & ' 6.2385514889727283E+00,-2.0836115686975827E+00,-1.4210737345008001E-01,', & ' 5.6327054260991156E+00,-4.6995588701197342E+00,-1.3946175745499875E-01,', & ' 3.4493163398727531E+00,-5.4809604515240968E+00,-1.4324120887654343E-01,', & ' 7.7750874644017181E+00,-6.2442206661050452E+00,-1.3114696432760045E-01,', & ' 1.0302217657417570E+01,-5.3974345751079591E+00,-1.3681614145991747E-01,', & ' 1.2074024483837716E+01,-6.9158291837135346E+00,-1.3662716888884024E-01,', & ' 1.0700382864677302E+01,-2.7907469296685923E+00,-1.4154045573684831E-01,', & ' 1.3246032369658721E+01,-1.7697281281382971E+00,-1.4210737345008001E-01,', & ' 7.4088586216540389E+00,-8.9590006222005893E+00,-1.1640710378357619E-01,', & ' 1.3870586717068980E+00, 2.0558326007492296E+00,-1.4172942830792554E-01,', & ' 1.3462405963542154E+00,-8.6360464982295970E-01, 1.5560001502499454E+00,', & ' 1.3462405963542154E+00,-8.6133697897003281E-01,-1.8434274308584184E+00,', & ' 5.6559490523416152E+00, 4.0016831651315083E+00,-1.4135148316577109E-01,', & ' 1.4674287061860456E+01,-3.2622334945062916E+00,-1.4343018144762065E-01,', & ' 1.3508893216027154E+01,-6.0811373372653921E-01, 1.5490081651200875E+00,', & ' 1.3507759380600691E+01,-6.0622400801576681E-01,-1.8320890765937843E+00,', & ' 5.4140641613627567E+00,-9.4924701903516215E+00,-1.1017100893802745E-01,', & ' 8.3191394965330758E+00,-9.7494728870166600E+00, 1.5654487788038070E+00,', & ' 8.3151710725404531E+00,-9.7685591166954602E+00,-1.7910820286700244E+00', & ' ],', & ' "molecular_charge": 0,', & ' "connectivity": [', & ' [ 0, 1, 1],', & ' [ 1, 2, 4],', & ' [ 2, 3, 4],', & ' [ 3, 4, 4],', & ' [ 1, 5, 1],', & ' [ 4, 5, 4],', & ' [ 5, 6, 1],', & ' [ 6, 7, 2],', & ' [ 6, 8, 1],', & ' [ 8, 9, 1],', & ' [ 9,10, 2],', & ' [ 4,11, 1],', & ' [ 9,11, 1],', & ' [11,12, 1],', & ' [ 8,13, 1],', & ' [ 0,14, 1],', & ' [ 0,15, 1],', & ' [ 0,16, 1],', & ' [ 2,17, 1],', & ' [12,18, 1],', & ' [12,19, 1],', & ' [12,20, 1],', & ' [13,21, 1],', & ' [13,22, 1],', & ' [13,23, 1]', & ' ]', & '}' close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_qcschema subroutine test_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".cjson" open(file=name, newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 1,', & ' "name": "Compound 11",', & ' "atoms": {', & ' "elements": {', & ' "number": [ 8, 6, 8, 6, 7, 6, 6, 6, 1, 1, 1, 1, 1, 1, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [', & ' -2.8211309999999998E+00, -2.7623799999999998E-01, -7.5313099999999999E-01,', & ' -2.0764070000000001E+00, 2.8899999999999992E-04, 1.7586399999999999E-01,', & ' -2.4698600000000002E+00, 8.7269300000000005E-01, 1.1265160000000001E+00,', & ' -6.4830699999999997E-01, -5.0843899999999997E-01, 3.8420700000000002E-01,', & ' -5.5372500000000002E-01, -1.9082209999999997E+00, -9.2136999999999997E-02,', & ' 3.0664000000000002E-01, 4.4865899999999997E-01, -3.5210999999999998E-01,', & ' 1.7648520000000001E+00, 1.6743700000000000E-01, -9.7096000000000002E-02,', & ' 2.5751040000000001E+00, 9.8444199999999993E-01, 5.8795099999999989E-01,', & ' -3.3913139999999999E+00, 1.0915140000000001E+00, 8.7361200000000006E-01,', & ' -4.3888700000000003E-01, -5.1347299999999996E-01, 1.4603180000000000E+00,', & ' 4.2120599999999997E-01, -2.1974659999999995E+00, -1.1177400000000000E-01,', & ' -8.9319499999999996E-01, -1.9465760000000001E+00, -1.0554429999999999E+00,', & ' 7.3376999999999998E-02, 1.4832350000000001E+00, -6.6298999999999997E-02,', & ' 1.2986000000000000E-01, 3.9679799999999998E-01, -1.4347600000000000E+00,', & ' 2.1793230000000001E+00, -7.4534500000000004E-01, -5.1925100000000002E-01,', & ' 2.2195890000000000E+00, 1.9142530000000000E+00, 1.0217970000000001E+00,', & ' 3.6228750000000001E+00, 7.3643800000000004E-01, 7.3077999999999999E-01', & ' ]', & ' }', & ' },', & ' "bonds": {', & ' "connections": {', & ' "index": [', & ' 0, 1,', & ' 1, 2,', & ' 3, 1,', & ' 3, 4,', & ' 3, 5,', & ' 5, 6,', & ' 6, 7,', & ' 2, 8,', & ' 3, 9,', & ' 4, 10,', & ' 4, 11,', & ' 5, 12,', & ' 5, 13,', & ' 6, 14,', & ' 7, 15,', & ' 7, 16', & ' ]', & ' },', & ' "order": [ 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1 ]', & ' }', & '}' close(unit) call read_structure(struc, name, error) open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_cjson function get_name() result(name) character(len=18) :: name real :: val call random_number(val) write(name, '(a, z8.8)') "mctc-test-", int(val*1.0e9) end function get_name end module test_read mctc-lib-0.3.2/test/test_read_aims.f90000066400000000000000000000411041466406626700175110ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_aims use mctc_env, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_aims use mctc_io_structure implicit none private public :: collect_read_aims contains !> Collect all exported unit tests subroutine collect_read_aims(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-aims", test_valid1_aims), & & new_unittest("valid2-aims", test_valid2_aims), & & new_unittest("valid3-aims", test_valid3_aims), & & new_unittest("valid4-aims", test_valid4_aims), & & new_unittest("valid5-aims", test_valid5_aims), & & new_unittest("valid6-aims", test_valid6_aims), & & new_unittest("valid7-aims", test_valid7_aims), & & new_unittest("invalid1-aims", test_invalid1_aims, should_fail=.true.), & & new_unittest("invalid2-aims", test_invalid2_aims, should_fail=.true.), & & new_unittest("invalid3-aims", test_invalid3_aims, should_fail=.true.), & & new_unittest("invalid4-aims", test_invalid4_aims, should_fail=.true.) & & ] end subroutine collect_read_aims subroutine test_valid1_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "atom -0.0090 -0.0157 -0.0000 C", & "atom -0.7131 1.2038 -0.0000 C", & "atom 1.3990 -0.0157 -0.0000 C", & "atom -0.0090 2.4232 -0.0000 C", & "atom 2.1031 1.2038 -0.0000 C", & "atom 1.3990 2.4232 0.0000 C", & "atom -0.5203 -0.9011 -0.0000 H", & "atom -1.7355 1.2038 0.0000 H", & "atom 1.9103 -0.9011 0.0000 H", & "atom -0.5203 3.3087 0.0000 H", & "atom 3.1255 1.2038 0.0000 H", & "atom 1.9103 3.3087 -0.0000 H" rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 12, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_aims subroutine test_valid2_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "atom 1.07317 0.04885 -0.07573 C ", & "atom 2.51365 0.01256 -0.07580 N ", & "atom 3.35199 1.09592 -0.07533 C* ", & "atom 4.61898 0.73028 -0.07549 N ", & "atom 4.57907 -0.63144 -0.07531 C* ", & "atom 3.30131 -1.10256 -0.07524 C ", & "atom 2.98068 -2.48687 -0.07377 C ", & "# special marked atom", & "atom 1.82530 -2.90038 -0.07577 18O", & "atom 4.11440 -3.30433 -0.06936 N ", & "atom 5.45174 -2.85618 -0.07235 C* ", & "atom 6.38934 -3.65965 -0.07232 O ", & "atom 5.66240 -1.47682 -0.07487 N ", & "atom 7.00947 -0.93648 -0.07524 C ", & "atom 3.92063 -4.74093 -0.06158 C ", & "# isotopes included here", & "atom 0.73398 1.08786 -0.07503 D ", & "atom 0.71239 -0.45698 0.82335 D ", & "atom 0.71240 -0.45580 -0.97549 D ", & "atom 2.99301 2.11762 -0.07478 H ", & "atom 7.76531 -1.72634 -0.07591 H ", & "atom 7.14864 -0.32182 0.81969 H ", & "atom 7.14802 -0.32076 -0.96953 H ", & "atom 2.86501 -5.02316 -0.05833 H ", & "atom 4.40233 -5.15920 0.82837 H ", & "atom 4.40017 -5.16929 -0.94780 H " rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 7, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_aims subroutine test_valid3_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "# 24", & "", & "atom 1.07317 0.04885 -0.07573 c", & "atom 2.51365 0.01256 -0.07580 n", & "atom 3.35199 1.09592 -0.07533 c", & "atom 4.61898 0.73028 -0.07549 n", & "atom 4.57907 -0.63144 -0.07531 c", & "atom 3.30131 -1.10256 -0.07524 c", & "atom 2.98068 -2.48687 -0.07377 c", & "atom 1.82530 -2.90038 -0.07577 o", & "atom 4.11440 -3.30433 -0.06936 n", & "atom 5.45174 -2.85618 -0.07235 c", & "atom 6.38934 -3.65965 -0.07232 o", & "atom 5.66240 -1.47682 -0.07487 n", & "atom 7.00947 -0.93648 -0.07524 c", & "atom 3.92063 -4.74093 -0.06158 c", & "atom 0.73398 1.08786 -0.07503 h", & "atom 0.71239 -0.45698 0.82335 h", & "atom 0.71240 -0.45580 -0.97549 h", & "atom 2.99301 2.11762 -0.07478 h", & "atom 7.76531 -1.72634 -0.07591 h", & "atom 7.14864 -0.32182 0.81969 h", & "atom 7.14802 -0.32076 -0.96953 h", & "atom 2.86501 -5.02316 -0.05833 h", & "atom 4.40233 -5.15920 0.82837 h", & "atom 4.40017 -5.16929 -0.94780 h" rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_aims subroutine test_valid4_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "lattice_vector 4.59373 0.00000 0.00000", & "lattice_vector 0.00000 4.59373 0.00000", & "lattice_vector 0.00000 0.00000 2.95812", & "atom 0.000000000 0.000000000 0.000000000 Ti", & "atom 2.296865000 2.296865000 1.479060000 Ti", & "atom 1.402465769 1.402465769 0.000000000 O", & "atom 3.191264231 3.191264231 0.000000000 O", & "atom 3.699330769 0.894399231 1.479060000 O", & "atom 0.894399231 3.699330769 1.479060000 O" rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return if (allocated(error)) return call check(error, struc%nat, 6, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_aims subroutine test_valid5_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "# cubic diamond", & "atom 0.0 0.0 0.0 C", & "atom_frac 0.25 0.25 0.25 C", & "lattice_vector 1.85 1.85 0.0", & "lattice_vector 0.0 1.85 1.85", & "lattice_vector 1.85 0.0 1.85" rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 2, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid5_aims subroutine test_valid6_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc1, struc2 integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "atom 0.00000000000000 0.00000000000000 0.00000000000000 Mg", & "atom 1.48881365396205 -1.48881365396205 0.00000000000000 O", & "atom 1.48881365396205 1.48881365396205 0.00000000000000 O", & "atom 0.00000000000000 0.00000000000000 2.10550046127949 O", & "atom 2.97762730792410 0.00000000000000 0.00000000000000 Mg", & "atom 1.48881365396205 -1.48881365396205 2.10550046127949 Mg", & "atom 1.48881365396205 1.48881365396205 2.10550046127949 Mg", & "atom 2.97762730792410 0.00000000000000 2.10550046127949 O", & "lattice_vector 2.97762730792410 -2.97762730792410 0.00000000000000", & "lattice_vector 2.97762730792410 2.97762730792410 0.00000000000000" rewind(unit) call read_aims(struc1, unit, error) close(unit) if (allocated(error)) return open(status='scratch', newunit=unit) write(unit, '(a)') & "atom_frac 0.00000000000000 0.00000000000000 0.00000000000000 Mg", & "atom_frac 0.50000000000000 0.00000000000000 0.00000000000000 O", & "atom_frac 0.00000000000000 0.50000000000000 0.00000000000000 O", & "atom_frac 0.00000000000000 0.00000000000000 2.10550046127949 O", & "atom_frac 0.50000000000000 0.50000000000000 0.00000000000000 Mg", & "atom_frac 0.50000000000000 0.00000000000000 2.10550046127949 Mg", & "atom_frac 0.00000000000000 0.50000000000000 2.10550046127949 Mg", & "atom_frac 0.50000000000000 0.50000000000000 2.10550046127949 O", & "lattice_vector 2.97762730792410 -2.97762730792410 0.00000000000000", & "lattice_vector 2.97762730792410 2.97762730792410 0.00000000000000" rewind(unit) call read_aims(struc2, unit, error) close(unit) if (allocated(error)) return call check(error, norm2(struc1%xyz - struc2%xyz), 0.0_wp, "Coordinates do not match") if (allocated(error)) return end subroutine test_valid6_aims subroutine test_valid7_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "atom -1.05835465887935 1.85522662363901 0.00000000000000 B", & "atom -1.05835465887935 1.57910813351869 1.38575958673374 N", & "atom -1.05835465887935 0.79318285794365 -0.93200541748473 N", & "atom -1.05835465887935 2.94621239911295 -0.36993970607209 H", & "atom -1.05835465887935 0.24094589146163 1.83951376127452 B", & "atom -1.05835465887935 -0.54497939258025 -0.47825125458585 B", & "atom -1.05835465887935 -0.82109787740880 0.90750834908157 N", & "atom -1.05835465887935 0.01583015330186 2.96930500972370 H", & "atom -1.05835465887935 -1.41084943428660 -1.23810284035547 H", & "atom -1.05835465887935 2.39762594336943 2.10405675666812 H", & "atom -1.05835465887935 -1.85242037510793 1.25721697940438 H", & "atom -1.05835465887935 1.00598756166737 -2.00001121245014 H", & "atom 1.05835465887935 0.82109787740880 -0.90750833320625 B", & "atom 1.05835465887935 0.54497938728848 0.47825125193996 N", & "atom 1.05835465887935 -0.24094588775739 -1.83951375598275 N", & "atom 1.05835465887935 1.91208365288273 -1.27744804245341 H", & "atom 1.05835465887935 -0.79318285794365 0.93200542277650 B", & "atom 1.05835465887935 -1.57910813881047 -1.38575959202551 B", & "atom 1.05835465887935 -1.85522662893078 0.00000001308910 N", & "atom 1.05835465887935 -1.01829859700301 2.06179667651746 H", & "atom 1.05835465887935 -2.44497818051681 -2.14561117356172 H", & "atom 1.05835465887935 1.36349719184744 1.19654842346187 H", & "atom 1.05835465887935 -2.88654912133814 0.34970864461060 H", & "atom 1.05835465887935 -0.02814118763207 -2.90751955094817 H", & "lattice_vector 4.23341864610095 0.00000000000000 0.00000000000000" rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 3, "Number of species does not match") if (allocated(error)) return call check(error, count(struc%periodic), 1, "Periodicity does not match") if (allocated(error)) return end subroutine test_valid7_aims subroutine test_invalid1_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "atom -0.0090 -0.0157 -0.0000 C", & "atom -0.7131 1.2038 -0.0000 C", & "atom 1.3990 -0.0157 -0.0000 C", & "atom -0.0090 2.4232 -0.0000 C", & "atom 2.1031 1.2038 -0.0000 C", & "atom 1.3990 2.4232 0.0000 C", & "atom -0.5203 -0.9011 -0.0000 hh", & "atom -1.7355 1.2038 0.0000 hh", & "atom 1.9103 -0.9011 0.0000 hh", & "atom -0.5203 3.3087 0.0000 H", & "atom 3.1255 1.2038 0.0000 H", & "atom 1.9103 3.3087 -0.0000 H" rewind(unit) call read_aims(struc, unit, error) close(unit) end subroutine test_invalid1_aims subroutine test_invalid2_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "# cubic diamond", & "atom 0.0 0.0 0.0 C", & "atom_frac 0.25 0.25 0.25 C", & "lattice 1.85 1.85 0.0", & "lattice 0.0 1.85 1.85", & "lattice 1.85 0.0 1.85" rewind(unit) call read_aims(struc, unit, error) close(unit) end subroutine test_invalid2_aims subroutine test_invalid3_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "lattice_vector 4.59373 0.00000 0.00000", & "lattice_vector 0.00000 4.59373 0.00000", & "lattice_vector 0.00000 abcdefg 2.95812", & "atom 0.000000000 0.000000000 0.000000000 Ti", & "atom 2.296865000 2.296865000 1.479060000 Ti", & "atom 1.402465769 1.402465769 0.000000000 O", & "atom 3.191264231 3.191264231 0.000000000 O", & "atom 3.699330769 0.894399231 1.479060000 O", & "atom 0.894399231 3.699330769 1.479060000 O" rewind(unit) call read_aims(struc, unit, error) close(unit) end subroutine test_invalid3_aims subroutine test_invalid4_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "# nothing", & "# to", & "# see", & "# here" rewind(unit) call read_aims(struc, unit, error) close(unit) end subroutine test_invalid4_aims end module test_read_aims mctc-lib-0.3.2/test/test_read_cjson.f90000066400000000000000000000527641466406626700177120ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_cjson use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_cjson use mctc_io_structure use mctc_version, only : get_mctc_feature implicit none private public :: collect_read_cjson contains !> Collect all exported unit tests subroutine collect_read_cjson(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) logical :: with_json with_json = get_mctc_feature("json") testsuite = [ & & new_unittest("valid1-cjson", test_valid1_cjson, should_fail=.not.with_json), & & new_unittest("valid2-cjson", test_valid2_cjson, should_fail=.not.with_json), & & new_unittest("valid3-cjson", test_valid3_cjson, should_fail=.not.with_json), & & new_unittest("valid4-cjson", test_valid4_cjson, should_fail=.not.with_json), & & new_unittest("valid5-cjson", test_valid5_cjson, should_fail=.not.with_json), & & new_unittest("valid6-cjson", test_valid6_cjson, should_fail=.not.with_json), & & new_unittest("invalid1-cjson", test_invalid1_cjson, should_fail=.true.), & & new_unittest("invalid2-cjson", test_invalid2_cjson, should_fail=.true.), & & new_unittest("invalid3-cjson", test_invalid3_cjson, should_fail=.true.), & & new_unittest("invalid4-cjson", test_invalid4_cjson, should_fail=.true.), & & new_unittest("invalid5-cjson", test_invalid5_cjson, should_fail=.true.), & & new_unittest("invalid6-cjson", test_invalid6_cjson, should_fail=.true.) & & ] end subroutine collect_read_cjson subroutine test_valid1_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 0,', & ' "name": "ethane",', & ' "inchi": "1/C2H6/c1-2/h1-2H3",', & ' "formula": "C 2 H 6",', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' },', & ' "bonds": {', & ' "connections": {', & ' "index": [ 0, 1,', & ' 1, 2,', & ' 1, 3,', & ' 1, 4,', & ' 4, 5,', & ' 4, 6,', & ' 4, 7 ]', & ' },', & ' "order": [ 1, 1, 1, 1, 1, 1, 1 ]', & ' },', & ' "properties": {', & ' "molecular mass": 30.0690,', & ' "melting point": -172,', & ' "boiling point": -88', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "ethane") if (allocated(error)) return call check(error, struc%nat, 8, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 7, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid1_cjson subroutine test_valid2_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 0,', & ' "name": "TiO2 rutile",', & ' "formula": "Ti 2 O 4",', & ' "unit cell": {', & ' "a": 2.95812,', & ' "b": 4.59373,', & ' "c": 4.59373,', & ' "alpha": 90.0,', & ' "beta": 90.0,', & ' "gamma": 90.0', & ' },', & ' "atoms": {', & ' "elements": {', & ' "number": [ 22, 22, 8, 8, 8, 8 ]', & ' },', & ' "coords": {', & ' "3d fractional": [ 0.00000, 0.00000, 0.00000,', & ' 0.50000, 0.50000, 0.50000,', & ' 0.00000, 0.30530, 0.30530,', & ' 0.00000, 0.69470, 0.69470,', & ' 0.50000, 0.19470, 0.80530,', & ' 0.50000, 0.80530, 0.19470 ]', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "TiO2 rutile") if (allocated(error)) return call check(error, struc%nat, 6, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_cjson subroutine test_valid3_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 0,', & ' "name": "ethane",', & ' "inchi": "1/C2H6/c1-2/h1-2H3",', & ' "formula": "C 2 H 6",', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' },', & ' "bonds": {', & ' "connections": {', & ' "index": [ 0, 1,', & ' 1, 2,', & ' 1, 3,', & ' 1, 4,', & ' 4, 5,', & ' 4, 6,', & ' 4, 7 ]', & ' }', & ' },', & ' "properties": {', & ' "molecular mass": 30.0690,', & ' "melting point": -172,', & ' "boiling point": -88', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "ethane") if (allocated(error)) return call check(error, struc%nat, 8, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 7, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid3_cjson subroutine test_valid4_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 1,', & ' "atoms": {', & ' "elements": {', & ' "number": [', & ' 6, 7, 6, 7, 6, 6, 6, 8, 7, 6, 8, 7, 6, 6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1', & ' ]', & ' },', & ' "coords": {', & ' "3d": [', & ' 1.0731997649702911E+00, 4.8899989290949721E-02, -7.5699983421776973E-02,', & ' 2.5136994495022558E+00, 1.2599997240612813E-02, -7.5799983399877077E-02,', & ' 3.3519992659154081E+00, 1.0958997599990143E+00, -7.5299983509376570E-02,', & ' 4.6189989884436962E+00, 7.3029984006504256E-01, -7.5499983465576764E-02,', & ' 4.5790989971817559E+00, -6.3139986172404194E-01, -7.5299983509376570E-02,', & ' 3.3012992770186567E+00, -1.1025997585317211E+00, -7.5199983531276451E-02,', & ' 2.9806993472297307E+00, -2.4868994553714288E+00, -7.3799983837875047E-02,', & ' 1.8252996002611557E+00, -2.9003993648153492E+00, -7.5799983399877077E-02,', & ' 4.1143990989505834E+00, -3.3042992763616597E+00, -6.9399984801470568E-02,', & ' 5.4516988060832432E+00, -2.8561993744951040E+00, -7.2399984144473614E-02,', & ' 6.3892986007497967E+00, -3.6596991985294207E+00, -7.2299984166373524E-02,', & ' 5.6623987599401575E+00, -1.4767996765823013E+00, -7.4899983596976152E-02,', & ' 7.0094984649266268E+00, -9.3649979490745228E-01, -7.5199983531276451E-02,', & ' 3.9205991413925863E+00, -4.7408989617477202E+00, -6.1599986509662634E-02,', & ' 7.3399983925474632E-01, 1.0878997617510062E+00, -7.4999983575076257E-02,', & ' 7.1239984398512435E-01, -4.5699989991746470E-01, 8.2339981967623732E-01,', & ' 7.1239984398512435E-01, -4.5579990018026340E-01, -9.7549978636649193E-01,', & ' 2.9929993445360430E+00, 2.1175995362477531E+00, -7.4799983618876062E-02,', & ' 7.7652982994071955E+00, -1.7262996219420552E+00, -7.5899983377977168E-02,', & ' 7.1485984344638682E+00, -3.2179992952612718E-01, 8.1969982048653345E-01,', & ' 7.1479984345952676E+00, -3.2079992974512617E-01, -9.6949978768048573E-01,', & ' 2.8649993725679135E+00, -5.0231988999243073E+00, -5.8299987232359275E-02,', & ' 4.4022990359007768E+00, -5.1591988701404459E+00, 8.2839981858124223E-01,', & ' 4.4001990363606742E+00, -5.1692988679285561E+00, -9.4779979243276369E-01', & ' ]', & ' }', & ' },', & ' "bonds": {', & ' "connections": {', & ' "index": [', & ' 0, 1,', & ' 1, 2,', & ' 2, 3,', & ' 3, 4,', & ' 1, 5,', & ' 4, 5,', & ' 5, 6,', & ' 6, 7,', & ' 6, 8,', & ' 8, 9,', & ' 9, 10,', & ' 4, 11,', & ' 9, 11,', & ' 11, 12,', & ' 8, 13,', & ' 0, 14,', & ' 0, 15,', & ' 0, 16,', & ' 2, 17,', & ' 12, 18,', & ' 12, 19,', & ' 12, 20,', & ' 13, 21,', & ' 13, 22,', & ' 13, 23', & ' ]', & ' },', & ' "order": [', & ' 1, 4, 4, 4, 1, 4, 1, 2, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1', & ' ]', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 25, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid4_cjson subroutine test_valid5_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemicalJson": 1,', & ' "atoms": {', & ' "elements": {', & ' "number": [', & ' 8,', & ' 1', & ' ]', & ' },', & ' "coords": {', & ' "3d": [', & ' 1.2358341722502633E+00,', & ' -9.1774253284895344E-02,', & ' -6.7936144993384059E-02,', & ' 1.5475582000473165E+00,', & ' 5.7192830956765273E-01,', & ' 5.5691301045614838E-01', & ' ]', & ' },', & ' "formalCharges": [ -1, 0 ]', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 2, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, nint(struc%charge), -1, "Total charge does not match") if (allocated(error)) return end subroutine test_valid5_cjson subroutine test_valid6_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemicalJson": 1,', & ' "atoms": {', & ' "elements": {', & ' "number": [', & ' 7,', & ' 7,', & ' 7', & ' ]', & ' },', & ' "coords": {', & ' "3d": [', & ' 3.6361808414857721E-01,', & ' 1.9287266130863627E+00,', & ' -1.7850498831821635E+00,', & ' 8.2217629145179161E-01,', & ' 2.4066501990670561E+00,', & ' -2.7896663819784173E+00,', & ' -9.4568423260748616E-02,', & ' 1.4516946870018026E+00,', & ' -7.7682289506097102E-01', & ' ]', & ' }', & ' },', & ' "properties": {', & ' "totalCharge": -1', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return call check(error, nint(struc%charge), -1, "Total charge does not match") if (allocated(error)) return end subroutine test_valid6_cjson subroutine test_invalid1_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemicalJson": -1,', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid1_cjson subroutine test_invalid2_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemicalJson": 1,', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid2_cjson subroutine test_invalid3_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemicalJson": 1,', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": null,', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid3_cjson subroutine test_invalid4_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid4_cjson subroutine test_invalid5_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemicalJson": 1,', & ' "atoms": {', & ' "elements": {', & ' "numbers": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid5_cjson subroutine test_invalid6_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 0,', & ' "name": "TiO2 rutile",', & ' "formula": "Ti 2 O 4",', & ' "unit cell": {', & ' "a": 2.95812,', & ' "b": 4.59373,', & ' "c": 4.59373,', & ' "alpha": 90.0,', & ' "beta": 90.0,', & ' "gama": 90.0', & ' },', & ' "atoms": {', & ' "elements": {', & ' "number": [ 22, 22, 8, 8, 8, 8 ]', & ' },', & ' "coords": {', & ' "3d fractional": [ 0.00000, 0.00000, 0.00000,', & ' 0.50000, 0.50000, 0.50000,', & ' 0.00000, 0.30530, 0.30530,', & ' 0.00000, 0.69470, 0.69470,', & ' 0.50000, 0.19470, 0.80530,', & ' 0.50000, 0.80530, 0.19470 ]', & ' }', & ' }', & '}' rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "TiO2 rutile") if (allocated(error)) return call check(error, struc%nat, 6, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_invalid6_cjson end module test_read_cjson mctc-lib-0.3.2/test/test_read_ctfile.f90000066400000000000000000001620501466406626700200320ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_ctfile use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_ctfile use mctc_io_structure implicit none private public :: collect_read_ctfile contains !> Collect all exported unit tests subroutine collect_read_ctfile(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-mol", test_valid1_mol), & & new_unittest("valid2-mol", test_valid2_mol), & & new_unittest("valid3-mol", test_valid3_mol), & & new_unittest("valid4-mol", test_valid4_mol), & & new_unittest("invalid1-mol", test_invalid1_mol, should_fail=.true.), & & new_unittest("invalid2-mol", test_invalid2_mol, should_fail=.true.), & & new_unittest("invalid3-mol", test_invalid3_mol, should_fail=.true.), & & new_unittest("invalid4-mol", test_invalid4_mol, should_fail=.true.), & & new_unittest("invalid5-mol", test_invalid5_mol, should_fail=.true.), & & new_unittest("invalid6-mol", test_invalid6_mol, should_fail=.true.), & & new_unittest("invalid7-mol", test_invalid7_mol, should_fail=.true.), & & new_unittest("invalid8-mol", test_invalid8_mol, should_fail=.true.), & & new_unittest("invalid9-mol", test_invalid9_mol, should_fail=.true.), & & new_unittest("maestro-mol", test_maestro_mol), & & new_unittest("valid1-sdf", test_valid1_sdf), & & new_unittest("valid2-sdf", test_valid2_sdf), & & new_unittest("valid3-sdf", test_valid3_sdf), & & new_unittest("invalid1-sdf", test_invalid1_sdf, should_fail=.true.), & & new_unittest("invalid2-sdf", test_invalid2_sdf, should_fail=.true.), & & new_unittest("invalid3-sdf", test_invalid3_sdf, should_fail=.true.), & & new_unittest("invalid4-sdf", test_invalid4_sdf, should_fail=.true.), & & new_unittest("invalid5-sdf", test_invalid5_sdf, should_fail=.true.), & & new_unittest("invalid6-sdf", test_invalid6_sdf, should_fail=.true.), & & new_unittest("invalid7-sdf", test_invalid7_sdf, should_fail=.true.), & & new_unittest("unsupported1-sdf", test_unsupported1_sdf, should_fail=.true.), & & new_unittest("unsupported2-sdf", test_unsupported2_sdf, should_fail=.true.), & & new_unittest("unsupported3-sdf", test_unsupported3_sdf, should_fail=.true.) & & ] end subroutine collect_read_ctfile subroutine test_valid1_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " Mrv1823 10191918163D ", & "", & " 12 12 0 0 0 0 999 V2000", & " -0.0090 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2 1 4 0 0 0 0", & " 3 1 4 0 0 0 0", & " 4 2 4 0 0 0 0", & " 5 3 4 0 0 0 0", & " 6 4 4 0 0 0 0", & " 6 5 4 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 12, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 12, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid1_mol subroutine test_valid2_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " xtb 09072013503D", & " xtb: 6.3.2 (b5103a3)", & " 24 25 0 0 0 999 V2000", & " 1.0732 0.0488 -0.0757 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.5137 0.0126 -0.0758 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.3520 1.0959 -0.0753 C* 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.6190 0.7303 -0.0755 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.5791 -0.6314 -0.0753 C* 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.3013 -1.1026 -0.0752 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.9807 -2.4869 -0.0738 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.8253 -2.9004 -0.0758 18O 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.1144 -3.3043 -0.0694 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 5.4517 -2.8562 -0.0723 C* 0 0 0 0 0 0 0 0 0 0 0 0", & " 6.3893 -3.6597 -0.0723 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 5.6624 -1.4768 -0.0749 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.0095 -0.9365 -0.0752 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.9206 -4.7409 -0.0616 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7340 1.0879 -0.0750 D 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7124 -0.4570 0.8234 D 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7124 -0.4558 -0.9755 D 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.9930 2.1176 -0.0748 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.7653 -1.7263 -0.0759 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.1486 -0.3218 0.8197 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 7.1480 -0.3208 -0.9695 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.8650 -5.0232 -0.0583 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.4023 -5.1592 0.8284 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 4.4002 -5.1693 -0.9478 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 1 0 0 0 0", & " 2 3 4 0 0 0 0", & " 3 4 4 0 0 0 0", & " 4 5 4 0 0 0 0", & " 2 6 1 0 0 0 0", & " 5 6 4 0 0 0 0", & " 6 7 1 0 0 0 0", & " 7 8 2 0 0 0 0", & " 7 9 1 0 0 0 0", & " 9 10 1 0 0 0 0", & " 10 11 2 0 0 0 0", & " 5 12 1 0 0 0 0", & " 10 12 1 0 0 0 0", & " 12 13 1 0 0 0 0", & " 9 14 1 0 0 0 0", & " 1 15 1 0 0 0 0", & " 1 16 1 0 0 0 0", & " 1 17 1 0 0 0 0", & " 3 18 1 0 0 0 0", & " 13 19 1 0 0 0 0", & " 13 20 1 0 0 0 0", & " 13 21 1 0 0 0 0", & " 14 22 1 0 0 0 0", & " 14 23 1 0 0 0 0", & " 14 24 1 0 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 7, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 25, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid2_mol subroutine test_valid3_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 1017", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 28 29 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -0.139802 -1.830034 0.709675 0", & "M V30 2 C -0.316756 -0.419558 0.542247 0 CFG=2", & "M V30 3 C -1.799960 -0.109911 0.488996 0", & "M V30 4 C 0.386061 0.062191 -0.739099 0", & "M V30 5 C -2.697868 -0.951923 -0.184715 0", & "M V30 6 C -2.294606 1.060665 1.085325 0", & "M V30 7 C 1.894644 0.013015 -0.632932 0", & "M V30 8 C -4.055760 -0.636028 -0.254512 0", & "M V30 9 C -3.653160 1.375870 1.014385 0", & "M V30 10 N 2.442088 -0.971958 0.125897 0", & "M V30 11 C 2.672560 0.914435 -1.356061 0", & "M V30 12 C -4.532743 0.527936 0.344354 0", & "M V30 13 C 3.791786 -1.035730 0.183623 0", & "M V30 14 C 4.059439 0.822550 -1.276192 0", & "M V30 15 C 4.633339 -0.168766 -0.490541 0", & "M V30 16 H 0.832285 -1.959785 0.673224 0", & "M V30 17 H 0.117435 0.060361 1.428520 0", & "M V30 18 H 0.082070 1.094331 -0.955596 0", & "M V30 19 H 0.094415 -0.560551 -1.594197 0", & "M V30 20 H -2.337706 -1.867971 -0.649441 0", & "M V30 21 H -1.623344 1.733954 1.613637 0", & "M V30 22 H -4.740022 -1.302611 -0.772469 0", & "M V30 23 H -4.025651 2.281920 1.484883 0", & "M V30 24 H 2.212518 1.677511 -1.976085 0", & "M V30 25 H -5.590493 0.771200 0.292658 0", & "M V30 26 H 4.192367 -1.831268 0.805865 0", & "M V30 27 H 4.686889 1.517092 -1.827730 0", & "M V30 28 H 5.709975 -0.266939 -0.409811 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 1 2 1", & "M V30 2 1 2 3", & "M V30 3 1 2 4", & "M V30 4 2 3 5", & "M V30 5 1 3 6", & "M V30 6 1 4 7", & "M V30 7 1 5 8", & "M V30 8 2 6 9", & "M V30 9 2 7 10", & "M V30 10 1 7 11", & "M V30 11 2 8 12", & "M V30 12 1 10 13", & "M V30 13 2 11 14", & "M V30 14 2 13 15", & "M V30 15 1 9 12", & "M V30 16 1 14 15", & "M V30 17 1 1 16", & "M V30 18 1 2 17 CFG=1", & "M V30 19 1 4 18", & "M V30 20 1 4 19", & "M V30 21 1 5 20", & "M V30 22 1 6 21", & "M V30 23 1 8 22", & "M V30 24 1 9 23", & "M V30 25 1 11 24", & "M V30 26 1 12 25", & "M V30 27 1 13 26", & "M V30 28 1 14 27", & "M V30 29 1 15 28", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 2)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return if (allocated(error)) return call check(error, struc%nat, 28, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 29, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid3_mol subroutine test_valid4_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 1016", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 21 21 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -1.686687 0.989923 -1.309588 0", & "M V30 2 C -1.641906 0.550463 0.052070 0 CFG=2", & "M V30 3 C -0.870884 -0.770712 0.137052 0", & "M V30 4 C -3.076970 0.377330 0.535110 0", & "M V30 5 C 0.620384 -0.546719 0.078757 0", & "M V30 6 N 1.280723 -0.500634 1.262879 0", & "M V30 7 C 1.265020 -0.375370 -1.143956 0", & "M V30 8 C 2.615192 -0.292093 1.219648 0", & "M V30 9 C 2.639873 -0.159926 -1.155509 0", & "M V30 10 C 3.332076 -0.118715 0.048112 0", & "M V30 11 H -2.097713 1.871989 -1.311606 0", & "M V30 12 H -1.148607 1.330233 0.644439 0", & "M V30 13 H -1.164397 -1.449978 -0.672900 0", & "M V30 14 H -1.097610 -1.279061 1.082626 0", & "M V30 15 H -3.629187 1.318763 0.441977 0", & "M V30 16 H -3.109338 0.058726 1.581416 0", & "M V30 17 H -3.609000 -0.361105 -0.074891 0", & "M V30 18 H 0.702849 -0.400424 -2.072665 0", & "M V30 19 H 3.109786 -0.266610 2.186219 0", & "M V30 20 H 3.163550 -0.022841 -2.096933 0", & "M V30 21 H 4.402843 0.046761 0.073357 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 1 2 1", & "M V30 2 1 2 3", & "M V30 3 1 2 4", & "M V30 4 1 3 5", & "M V30 5 2 5 6", & "M V30 6 1 5 7", & "M V30 7 1 6 8", & "M V30 8 2 7 9", & "M V30 9 2 8 10", & "M V30 10 1 9 10", & "M V30 11 1 1 11", & "M V30 12 1 2 12 CFG=1", & "M V30 13 1 3 13", & "M V30 14 1 3 14", & "M V30 15 1 4 15", & "M V30 16 1 4 16", & "M V30 17 1 4 17", & "M V30 18 1 7 18", & "M V30 19 1 8 19", & "M V30 20 1 9 20", & "M V30 21 1 10 21", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 2)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return if (allocated(error)) return call check(error, struc%nat, 21, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 21, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid4_mol subroutine test_invalid1_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " OpenBabel10191918023D", & "", & " 12 12 0 0 0 0 0 0 0 0999 V2000", & " -0.0090 -0.0157 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 2 0 0 0 0", & " 1 3 1 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 4 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 5 2 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 6 2 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 6 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid1_mol subroutine test_invalid2_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " 10191918023D", & "", & " 12 12 0 0 0 0 0 0 0 0999 V2000", & " -0.0090 -0.0157 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid2_mol subroutine test_invalid3_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " 10191918163D ", & "", & " 12 12 0 0 0 0 999 V2000", & " -0.0090 -0.0157 -0.0000 *** 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 -0.0000 *** 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 -0.0000 *** 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 -0.0000 *** 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 -0.0000 *** 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 *** 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2 1 4 0 0 0 0", & " 3 1 4 0 0 0 0", & " 4 2 4 0 0 0 0", & " 5 3 4 0 0 0 0", & " 6 4 4 0 0 0 0", & " 6 5 4 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid3_mol subroutine test_invalid4_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " Mrv1823 10191918163D ", & "", & " 12 12 0 0 0 0 999 V2000", & " -0.0090 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2 1 4 0 0 0 0", & " 3 1 4 0 0 0 0", & " 4 2 4 0 0 0 0", & " 5 3 4 0 0 0 0", & " 6 4 4 0 0 0 0", & " 6 5 4 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M CHG 3 1 1 3 b 2 -1", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid4_mol subroutine test_invalid5_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " Mrv1823 10191918163D ", & "", & " 0 12 0 0 0 0 999 V2000", & " 2 1 4 0 0 0 0", & " 3 1 4 0 0 0 0", & " 4 2 4 0 0 0 0", & " 5 3 4 0 0 0 0", & " 6 4 4 0 0 0 0", & " 6 5 4 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid5_mol subroutine test_invalid6_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 16 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 END CTAB", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid6_mol subroutine test_invalid7_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 BEGIN INVALID", & "M V30 END INVALID", & "M V30 END CTAB", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid7_mol subroutine test_invalid8_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 15 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 END CTAB", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid8_mol subroutine test_invalid9_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid9_mol subroutine test_maestro_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 2244", & " 3D", & " Schrodinger Suite 2022-1.", & " 21 21 0 0 1 0 999 V2000", & " 1.2333 0.5540 0.7792 O 0 0 0 0 0 0", & " -0.6952 -2.7148 -0.7502 O 0 0 0 0 0 0", & " 0.7958 -2.1843 0.8685 O 0 0 0 0 0 0", & " 1.7813 0.8105 -1.4821 O 0 0 0 0 0 0", & " -0.0857 0.6088 0.4403 C 0 0 0 0 0 0", & " -0.7927 -0.5515 0.1244 C 0 0 0 0 0 0", & " -0.7288 1.8464 0.4133 C 0 0 0 0 0 0", & " -2.1426 -0.4741 -0.2184 C 0 0 0 0 0 0", & " -2.0787 1.9238 0.0706 C 0 0 0 0 0 0", & " -2.7855 0.7636 -0.2453 C 0 0 0 0 0 0", & " -0.1409 -1.8536 0.1477 C 0 0 0 0 0 0", & " 2.1094 0.6715 -0.3113 C 0 0 0 0 0 0", & " 3.5305 0.5996 0.1635 C 0 0 0 0 0 0", & " -0.1851 2.7545 0.6593 H 0 0 0 0 0 0", & " -2.7247 -1.3605 -0.4564 H 0 0 0 0 0 0", & " -2.5797 2.8872 0.0506 H 0 0 0 0 0 0", & " -3.8374 0.8238 -0.5090 H 0 0 0 0 0 0", & " 3.7290 1.4184 0.8593 H 0 0 0 0 0 0", & " 4.2045 0.6969 -0.6924 H 0 0 0 0 0 0", & " 3.7105 -0.3659 0.6426 H 0 0 0 0 0 0", & " -0.2555 -3.5916 -0.7337 H 0 0 0 0 0 0", & " 1 5 1 0 0 0", & " 1 12 1 0 0 0", & " 2 11 1 0 0 0", & " 2 21 1 0 0 0", & " 3 11 2 0 0 0", & " 4 12 2 0 0 0", & " 5 6 1 0 0 0", & " 5 7 2 0 0 0", & " 6 8 2 0 0 0", & " 6 11 1 0 0 0", & " 7 9 1 0 0 0", & " 7 14 1 0 0 0", & " 8 10 1 0 0 0", & " 8 15 1 0 0 0", & " 9 10 2 0 0 0", & " 9 16 1 0 0 0", & " 10 17 1 0 0 0", & " 12 13 1 0 0 0", & " 13 18 1 0 0 0", & " 13 19 1 0 0 0", & " 13 20 1 0 0 0", & "M END" rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return if (allocated(error)) return call check(error, struc%nat, 21, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 3, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 21, "Number of bonds does not match") if (allocated(error)) return end subroutine test_maestro_mol subroutine test_valid1_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " OpenBabel10191918023D", & "", & " 12 12 0 0 0 0 0 0 0 0999 V2000", & " -0.0090 -0.0157 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 2 0 0 0 0", & " 1 3 1 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 4 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 5 2 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 6 2 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 6 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END", & "$$$$" rewind(unit) call read_sdf(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 12, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 12, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid1_sdf subroutine test_valid2_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "962", & " Marvin 12300703363D ", & "", & " 3 2 0 0 0 0 999 V2000", & " -0.2309 -0.3265 0.0000 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7484 -0.2843 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5175 0.6108 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 1 0 0 0 0", & " 1 3 1 0 0 0 0", & "M END", & "", & "> ", & "InChI=1S/H2O/h1H2", & "", & "> ", & "XLYOFNOQVPJJNP-UHFFFAOYSA-N", & "", & "> ", & "1/0/N:1/rA:3nOHH/rB:s1;s1;/rC:-.2309,-.3265,0;.7484,-.2843,0;-.5175,.6108,0;", & "", & "> ", & "H2 O", & "", & "> ", & "18.01528", & "", & "> ", & "O([H])[H]", & "", & "> ", & "937", & "", & "$$$$", & "", & " OpenBabel10191919063D", & "", & " 3 2 0 0 0 0 0 0 0 0999 V2000", & " 0.9688 -0.1102 0.0277 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9367 -0.0652 0.0164 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.2155 -0.9652 0.2426 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 1 0 0 0 0", & " 2 3 1 0 0 0 0", & "M END", & "$$$$" rewind(unit) call read_sdf(struc, unit, error) if (.not.allocated(error)) then call check(error, allocated(struc%comment), "Comment line should be saved") if (.not.allocated(error)) then call read_sdf(struc, unit, error) end if end if close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 2, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid2_sdf subroutine test_valid3_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0 CFG=1", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 4)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return if (allocated(error)) return call check(error, struc%nat, 17, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%nbd, 16, "Number of bonds does not match") if (allocated(error)) return end subroutine test_valid3_sdf subroutine test_invalid1_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " Mrv1823 10191918163D ", & "", & " 12 12 0 0 0 0 999 V2000", & " -0.0090 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2 1 4 0 0 0 0", & " 3 1 4 0 0 0 0", & " 4 2 4 0 0 0 0", & " 5 3 4 0 0 0 0", & " 6 4 4 0 0 0 0", & " 6 5 4 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END" rewind(unit) call read_sdf(struc, unit, error) close(unit) end subroutine test_invalid1_sdf subroutine test_invalid2_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " Mrv1823 10191918163D ", & "", & " 12 18 0 0 0 0 999 V2000", & " -0.0090 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.7131 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 -0.0157 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.0090 2.4232 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.1031 1.2038 -0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.3990 2.4232 0.0000 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 -0.9011 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.7355 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 -0.9011 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5203 3.3087 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 3.1255 1.2038 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.9103 3.3087 -0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 2 1 4 0 0 0 0", & " 3 1 4 0 0 0 0", & " 4 2 4 0 0 0 0", & " 5 3 4 0 0 0 0", & " 6 4 4 0 0 0 0", & " 6 5 4 0 0 0 0", & " 1 7 1 0 0 0 0", & " 2 8 1 0 0 0 0", & " 3 9 1 0 0 0 0", & " 4 10 1 0 0 0 0", & " 5 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & "M END", & "$$$$" rewind(unit) call read_sdf(struc, unit, error) close(unit) end subroutine test_invalid2_sdf subroutine test_invalid3_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "962", & " 12300703363D ", & "", & " 3 2 0 0 0 0 999 V2000", & " -0.2309 -0.3265 0.0000 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7484 -0.2843 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5175 0.6108 0.0000 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 1 0 0 0 0", & " 1 3 1 0 0 0 0", & "", & "> ", & "InChI=1S/H2O/h1H2", & "", & "> ", & "XLYOFNOQVPJJNP-UHFFFAOYSA-N", & "", & "> ", & "1/0/N:1/rA:3nOHH/rB:s1;s1;/rC:-.2309,-.3265,0;.7484,-.2843,0;-.5175,.6108,0;", & "", & "> ", & "H2 O", & "", & "> ", & "18.01528", & "", & "> ", & "O([H])[H]", & "", & "> ", & "937", & "", & "$$$$" rewind(unit) call read_sdf(struc, unit, error) if (.not.allocated(error)) then call read_sdf(struc, unit, error) end if close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_invalid3_sdf subroutine test_invalid4_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & " xtb 08072014173D", & "", & " 13 13 0 0 0 999 V2000", & " 1.4896 -2.2438 -0.0275 O 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.8475 -1.2058 -0.0075 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.4981 0.0466 0.2360 C 0 0 0 0 0 0 0 0 0 0 0 0", & " 0.7744 1.2240 0.2564 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5681 1.2354 0.0512 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.3469 -0.0099 -0.2052 C 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.5125 -1.2225 -0.2193 N 0 0 0 0 0 0 0 0 0 0 0 0", & " 2.5680 0.0344 0.3998 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1.2958 2.1567 0.4406 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.0960 2.1819 0.0742 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -1.8599 0.0606 -1.1755 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -2.1168 -0.1374 0.5699 H 0 0 0 0 0 0 0 0 0 0 0 0", & " -0.9728 -2.1202 -0.3930 H 0 0 0 0 0 0 0 0 0 0 0 0", & " 1 2 2 0 0 0 0", & " 2 3 1 0 0 0 0", & " 3 4 2 0 0 0 0", & " 3 8 1 0 0 0 0", & " 4 5 1 0 0 0 0", & " 4 9 1 0 0 0 0", & " 5 6 1 0 0 0 0", & " 5 10 1 0 0 0 0", & " 6 7 1 0 0 0 0", & " 6 11 1 0 0 0 0", & " 6 12 1 0 0 0 0", & " 7 2 1 0 0 0 0", & " 7 13 1 0 0 0 0", & "M CHG 1 5 1", & "M END", & "> ", & "-18.421705869411", & "", & "> ", & "0.000695317397", & "", & "$$$$" rewind(unit) call read_sdf(struc, unit, error) end subroutine test_invalid4_sdf subroutine test_invalid5_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0 CFG=1", & "M V30 5 N -0.553725 -1.908221 -0.092137 0 CHG=b", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 4)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid5_sdf subroutine test_invalid6_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0 CFG=1", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 * 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 4)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid6_sdf subroutine test_invalid7_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 a 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 0", & "M V30 4 C -0.648307 -0.508439 0.384207 0 CFG=1", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 C 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 4)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_invalid7_sdf subroutine test_unsupported1_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 17 16 0 0 0", & "M V30 BEGIN ATOM", & "M V30 1 O -2.821131 -0.276238 -0.753131 0", & "M V30 2 C -2.076407 0.000289 0.175864 0", & "M V30 3 O -2.469860 0.872693 1.126516 1", & "M V30 4 C -0.648307 -0.508439 0.384207 0 CFG=1", & "M V30 5 N -0.553725 -1.908221 -0.092137 0", & "M V30 6 C 0.306640 0.448659 -0.352110 0", & "M V30 7 C 1.764852 0.167437 -0.097096 0", & "M V30 8 * 2.575104 0.984442 0.587951 0", & "M V30 9 H -3.391314 1.091514 0.873612 0", & "M V30 10 H -0.438887 -0.513473 1.460318 0", & "M V30 11 H 0.421206 -2.197466 -0.111774 0", & "M V30 12 H -0.893195 -1.946576 -1.055443 0", & "M V30 13 H 0.073377 1.483235 -0.066299 0", & "M V30 14 H 0.129860 0.396798 -1.434760 0", & "M V30 15 H 2.179323 -0.745345 -0.519251 0", & "M V30 16 H 2.219589 1.914253 1.021797 0", & "M V30 17 H 3.622875 0.736438 0.730780 0", & "M V30 END ATOM", & "M V30 BEGIN BOND", & "M V30 1 2 1 2", & "M V30 2 1 2 3", & "M V30 3 1 4 2", & "M V30 4 1 4 5", & "M V30 5 1 4 6", & "M V30 6 1 6 7", & "M V30 7 2 7 8 CFG=2", & "M V30 8 1 3 9", & "M V30 9 1 4 10 CFG=1", & "M V30 10 1 5 11", & "M V30 11 1 5 12", & "M V30 12 1 6 13", & "M V30 13 1 6 14", & "M V30 14 1 7 15", & "M V30 15 1 8 16", & "M V30 16 1 8 17", & "M V30 END BOND", & "M V30 BEGIN COLLECTION", & "M V30 MDLV30/STERAC1 ATOMS=(1 4)", & "M V30 END COLLECTION", & "M V30 END CTAB", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_unsupported1_sdf subroutine test_unsupported2_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M V30 BEGIN CTAB", & "M V30 COUNTS 0 0 0 0 0", & "M V30 END CTAB", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_unsupported2_sdf subroutine test_unsupported3_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Compound 11", & " RDKit 3D", & "", & " 0 0 0 0 0 0 0 0 0 0999 V3000", & "M END", & "> (1) ", & "NC(CC=C)C(=O)O", & "", & "$$$$" rewind(unit) call read_molfile(struc, unit, error) close(unit) end subroutine test_unsupported3_sdf end module test_read_ctfile mctc-lib-0.3.2/test/test_read_gaussian.f90000066400000000000000000000151131466406626700203730ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_gaussian use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_gaussian use mctc_io_structure implicit none private public :: collect_read_gaussian contains !> Collect all exported unit tests subroutine collect_read_gaussian(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-ein", test_valid1_ein), & & new_unittest("invalid1-ein", test_invalid1_ein, should_fail=.true.), & & new_unittest("invalid2-ein", test_invalid2_ein, should_fail=.true.), & & new_unittest("invalid3-ein", test_invalid3_ein, should_fail=.true.), & & new_unittest("invalid4-ein", test_invalid4_ein, should_fail=.true.) & & ] end subroutine collect_read_gaussian subroutine test_valid1_ein(error) use mctc_env_accuracy, only : wp !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 4 1 0 1", & " 7 0.000000000000 0.000000000000 -0.114091591161 0.000000000000 ", & " 1 -1.817280998039 0.000000000000 0.528409372569 0.000000000000 ", & " 1 0.908640499019 -1.573811509290 0.528409372569 0.000000000000 ", & " 1 0.908640499019 1.573811509290 0.528409372569 0.000000000000 ", & " 1 2 1.000 3 1.000 4 1.000", & " 2 1 1.000", & " 3 1 1.000", & " 4 1 1.000" rewind(unit) call read_gaussian_external(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 4, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, struc%xyz(1,1), 0.000000000000_wp, thr=1.0e-10_wp, message="Coordinates do not match") if (allocated(error)) return call check(error, struc%xyz(3,2), 0.528409372569_wp, thr=1.0e-10_wp,message="Coordinates do not match") if (allocated(error)) return call check(error, struc%xyz(2,3), -1.573811509290_wp, thr=1.0e-10_wp, message="Coordinates do not match") if (allocated(error)) return end subroutine test_valid1_ein subroutine test_invalid1_ein(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 4 1 zero one", & " 7 0.000000000000 0.000000000000 -0.114091591161 0.000000000000 ", & " 1 -1.817280998039 0.000000000000 0.528409372569 0.000000000000 ", & " 1 0.908640499019 -1.573811509290 0.528409372569 0.000000000000 ", & " 1 0.908640499019 1.573811509290 0.528409372569 0.000000000000 ", & " 1 2 1.000 3 1.000 4 1.000", & " 2 1 1.000", & " 3 1 1.000", & " 4 1 1.000" rewind(unit) call read_gaussian_external(struc, unit, error) close(unit) end subroutine test_invalid1_ein subroutine test_invalid2_ein(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " -4 1 0 1", & " 7 0.000000000000 0.000000000000 -0.114091591161 0.000000000000 ", & " 1 -1.817280998039 0.000000000000 0.528409372569 0.000000000000 ", & " 1 0.908640499019 -1.573811509290 0.528409372569 0.000000000000 ", & " 1 0.908640499019 1.573811509290 0.528409372569 0.000000000000 ", & " 1 2 1.000 3 1.000 4 1.000", & " 2 1 1.000", & " 3 1 1.000", & " 4 1 1.000" rewind(unit) call read_gaussian_external(struc, unit, error) close(unit) end subroutine test_invalid2_ein subroutine test_invalid3_ein(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 4 1 0 1", & " 7 0.000000000000 0.000000000000 -0.114091591161 0.000000000000 ", & " 1 -1.817280998039 0.000000000000 0.528409372569 0.000000000000 ", & " 1 0.908640499019 -1.573811509290 0.528409372569 0.000000000000 ", & " 1 abcd.efgh-jklm 1.573811509290 0.528409372569 0.000000000000 ", & " 1 2 1.000 3 1.000 4 1.000", & " 2 1 1.000", & " 3 1 1.000", & " 4 1 1.000" rewind(unit) call read_gaussian_external(struc, unit, error) close(unit) end subroutine test_invalid3_ein subroutine test_invalid4_ein(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 4 1 0 1", & " 7 0.000000000000 0.000000000000 -0.114091591161 0.000000000000 ", & " 1 -1.817280998039 0.000000000000 0.528409372569 0.000000000000 ", & " 1 0.908640499019 -1.573811509290 0.528409372569 0.000000000000 ", & " -1 0.908640499019 1.573811509290 0.528409372569 0.000000000000 ", & " 1 2 1.000 3 1.000 4 1.000", & " 2 1 1.000", & " 3 1 1.000", & " 4 1 1.000" rewind(unit) call read_gaussian_external(struc, unit, error) close(unit) end subroutine test_invalid4_ein end module test_read_gaussian mctc-lib-0.3.2/test/test_read_genformat.f90000066400000000000000000000362411466406626700205500ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_genformat use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_genformat use mctc_io_structure implicit none private public :: collect_read_genformat contains !> Collect all exported unit tests subroutine collect_read_genformat(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-gen", test_valid1_gen), & & new_unittest("valid2-gen", test_valid2_gen), & & new_unittest("valid3-gen", test_valid3_gen), & & new_unittest("valid4-gen", test_valid4_gen), & & new_unittest("valid5-gen", test_valid5_gen), & & new_unittest("valid6-gen", test_valid6_gen), & & new_unittest("invalid1-gen", test_invalid1_gen, should_fail=.true.), & & new_unittest("invalid2-gen", test_invalid2_gen, should_fail=.true.), & & new_unittest("invalid3-gen", test_invalid3_gen, should_fail=.true.), & & new_unittest("invalid4-gen", test_invalid4_gen, should_fail=.true.), & & new_unittest("invalid5-gen", test_invalid5_gen, should_fail=.true.), & & new_unittest("invalid6-gen", test_invalid6_gen, should_fail=.true.), & & new_unittest("invalid7-gen", test_invalid7_gen, should_fail=.true.), & & new_unittest("invalid8-gen", test_invalid8_gen, should_fail=.true.), & & new_unittest("invalid9-gen", test_invalid9_gen, should_fail=.true.) & & ] end subroutine collect_read_genformat subroutine test_valid1_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3 C", & "O H", & "# B3LYP geometry", & "1 1 0.00000 0.00000 0.11974", & "2 2 0.00000 0.76158 -0.47898", & "2 2 0.00000 -0.76158 -0.47898" rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_gen subroutine test_valid2_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "9 C", & "C Br H O", & " 1 1 -8.9147060000E-02 -6.6786080000E-02 -1.0432907000E-01", & " 2 2 1.7639746700E+00 2.6771621000E-01 4.2178865000E-01", & " 3 3 -2.6325805000E-01 -1.1300550700E+00 -1.3052621000E-01", & " 4 3 -7.4963702000E-01 3.9302570000E-01 6.1238499000E-01", & " 5 3 -2.6130022000E-01 3.5462634000E-01 -1.0812232600E+00", & " 6 4 4.7684499800E+00 7.6734388000E-01 1.2078966200E+00", & " 7 1 5.5165496700E+00 2.5437564000E-01 4.3331738000E-01", & " 8 3 6.6378745000E+00 3.1585526000E-01 5.3760272000E-01", & " 9 3 5.1708208600E+00 -3.3263252000E-01 -4.6451965000E-01" rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 9, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_gen subroutine test_valid3_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "8 S", & "C", & " 1 1 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00", & " 2 1 -0.0000000000E+00 1.7833900000E+00 1.7834000000E+00", & " 3 1 1.7833900000E+00 1.7834000000E+00 0.0000000000E+00", & " 4 1 1.7833900000E+00 -0.0000000000E+00 1.7834000000E+00", & " 5 1 2.6750900000E+00 8.9170000000E-01 2.6750900000E+00", & " 6 1 8.9170000000E-01 8.9170000000E-01 8.9170000000E-01", & " 7 1 8.9170000000E-01 2.6750900000E+00 2.6750900000E+00", & " 8 1 2.6750900000E+00 2.6750900000E+00 8.9170000000E-01", & "0.0 0.0 0.0", & "3.567 0.0 0.0", & "0.0 3.567 0.0", & "0.0 0.0 3.567" rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 8, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_gen subroutine test_valid4_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "2 F", & "Ga As", & "1 1 0.00 0.00 0.00", & "2 2 0.25 0.25 0.25", & "0.0000000E+00 0.0000000E+00 0.0000000E+00", & "0.2713546E+01 0.2713546E+01 0.0000000E+00", & "0.0000000E+00 0.2713546E+01 0.2713546E+01", & "0.2713546E+01 0.0000000E+00 0.2713546E+01" rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 2, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_gen subroutine test_valid5_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 20 H", & " C", & " 1 1 0.2756230044E+01 0.2849950460E+01 0.1794011798E+01", & " 2 1 0.2656226397E+01 0.2949964389E+01 0.3569110265E+00", & " 3 1 0.4149823216E+00 0.3947943175E+01 0.1774023191E+01", & " 4 1 -0.1984731085E+01 0.3437783679E+01 0.1784008240E+01", & " 5 1 -0.3626350732E+01 0.1614594006E+01 0.1784022394E+01", & " 6 1 -0.3882893767E+01 -0.8252790149E+00 0.1784006601E+01", & " 7 1 -0.2656230041E+01 -0.2949950471E+01 0.1784011798E+01", & " 8 1 -0.4149823216E+00 -0.3947943175E+01 0.1784023191E+01", & " 9 1 0.1984731085E+01 -0.3437783679E+01 0.1784008240E+01", & " 10 1 0.3626350732E+01 -0.1614594006E+01 0.1784022394E+01", & " 11 1 0.3882893767E+01 0.8252790258E+00 0.1784006601E+01", & " 12 1 0.4149905833E+00 0.3947943870E+01 0.3569255177E+00", & " 13 1 -0.1984725150E+01 0.3437762712E+01 0.3569151866E+00", & " 14 1 -0.3626358050E+01 0.1614595957E+01 0.3569260541E+00", & " 15 1 -0.3882900023E+01 -0.8252696970E+00 0.3569133218E+00", & " 16 1 -0.2656226396E+01 -0.2949964400E+01 0.3569110265E+00", & " 17 1 -0.4149905833E+00 -0.3947943870E+01 0.3569255177E+00", & " 18 1 0.1984725150E+01 -0.3437762712E+01 0.3569151866E+00", & " 19 1 0.3626358050E+01 -0.1614595957E+01 0.3569260541E+00", & " 20 1 0.3882900026E+01 0.8252697074E+00 0.3569133218E+00", & " 0 0 0", & " 0.2140932670E+01 18.0 1" rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, count(struc%periodic), 1, "Incorrect periodicity") if (allocated(error)) return call check(error, struc%nat, 20, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid5_gen subroutine test_valid6_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 2 H", & " C", & " 1 1 0.0 0.0 1.4271041431", & " 2 1 0.0 0.0 0.0", & " -0.2703556133E+01 -0.2906666140E+01 -0.3618948259E+00", & " 0.2140932670E+01 18.00000000 10" rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, count(struc%periodic), 1, "Incorrect periodicity") if (allocated(error)) return call check(error, struc%nat, 2, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid6_gen subroutine test_invalid1_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "-2 F", & "Ga As", & "1 1 0.00 0.00 0.00", & "2 2 0.25 0.25 0.25", & "0.0000000E+00 0.0000000E+00 0.0000000E+00", & "0.2713546E+01 0.2713546E+01 0.0000000E+00", & "0.0000000E+00 0.2713546E+01 0.2713546E+01", & "0.2713546E+01 0.0000000E+00 0.2713546E+01" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid1_gen subroutine test_invalid2_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "2 X", & "Ga As", & "1 1 0.00 0.00 0.00", & "2 2 0.25 0.25 0.25", & "0.0000000E+00 0.0000000E+00 0.0000000E+00", & "0.2713546E+01 0.2713546E+01 0.0000000E+00", & "0.0000000E+00 0.2713546E+01 0.2713546E+01", & "0.2713546E+01 0.0000000E+00 0.2713546E+01" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid2_gen subroutine test_invalid3_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "2 F", & "Ga ***As", & "1 1 0.00 0.00 0.00", & "2 2 0.25 0.25 0.25", & "0.0000000E+00 0.0000000E+00 0.0000000E+00", & "0.2713546E+01 0.2713546E+01 0.0000000E+00", & "0.0000000E+00 0.2713546E+01 0.2713546E+01", & "0.2713546E+01 0.0000000E+00 0.2713546E+01" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid3_gen subroutine test_invalid4_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "2 F", & "Ga As" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid4_gen subroutine test_invalid5_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "2 F", & "Ga As", & "1 1 0.00 0.00 0.00", & "2 2 0.25 0.25 0.25" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid5_gen subroutine test_invalid6_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "2 F", & "Ga As", & "1 1 0.00 0.00 0.00", & "2 2 0.25 0.25 0.25", & "0.0000000E+00 0.0000000E+00 0.0000000E+00", & "************* ************* 0.0000000E+00", & "0.0000000E+00 ************* *************", & "************* 0.0000000E+00 *************" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid6_gen subroutine test_invalid7_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "12 H", & " C H ", & " 1 1 1.39792890 0.00000000 -0.00000000", & " 2 2 2.49455487 -0.00000000 0.00000000", & " 3 1 0.69896445 1.21064194 -0.00000000", & " 4 2 1.24727743 2.16034789 0.00000000", & " 5 1 -0.69896445 1.21064194 -0.00000000", & " 6 2 -1.24727743 2.16034789 0.00000000", & " 7 1 -1.39792890 -0.00000000 -0.00000000", & " 8 2 -2.49455487 0.00000000 0.00000000", & " 9 1 -0.69896445 -1.21064194 -0.00000000", & "10 2 -1.24727743 -2.16034789 0.00000000", & "11 1 0.69896445 -1.21064194 -0.00000000", & "12 2 1.24727743 -2.16034789 0.00000000", & " 0 0 0", & " 3.0 ***** 1" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid7_gen subroutine test_invalid8_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 2 H", & " C", & " 1 1 0.2756230044E+01 0.2849950460E+01 0.1794011798E+01", & " 2 1 0.2656226397E+01 0.2949964389E+01 0.3569110265E+00", & " 0 0 0", & " 0.2140932670E+01 18.0 -10" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid8_gen subroutine test_invalid9_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " 2 S", & " C", & " 1 1 0.0000000000E+00 0.0000000000E+00 0.0000000000E+00", & " 2 1 1.5000000000E+00 0.0000000000E+00 0.0000000000E+00", & " 0.0000000000E+00 0.0000000000E+00", & " 0.2000000000E+01 0.0000000000E+00 0.0000000000E+00", & " 0.0000000000E+00 0.1000000000E+03 0.0000000000E+00", & " 0.0000000000E+00 0.0000000000E+00 0.1000000000E+03" rewind(unit) call read_genformat(struc, unit, error) close(unit) end subroutine test_invalid9_gen end module test_read_genformat mctc-lib-0.3.2/test/test_read_pdb.f90000066400000000000000000001072541466406626700173360ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_pdb use mctc_env_accuracy, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_pdb use mctc_io_structure, only : structure_type implicit none private public :: collect_read_pdb contains !> Collect all exported unit tests subroutine collect_read_pdb(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-pdb", test_valid1_pdb), & & new_unittest("valid2-pdb", test_valid2_pdb), & & new_unittest("valid3-pdb", test_valid3_pdb), & & new_unittest("valid4-pdb", test_valid4_pdb), & & new_unittest("invalid1-pdb", test_invalid1_pdb, should_fail=.true.), & & new_unittest("invalid2-pdb", test_invalid2_pdb, should_fail=.true.), & & new_unittest("invalid3-pdb", test_invalid3_pdb, should_fail=.true.) & & ] end subroutine collect_read_pdb subroutine test_valid1_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "ATOM 1 N GLY Z 1 -0.821 -2.072 16.609 1.00 9.93 N1+", & "ATOM 2 CA GLY Z 1 -1.705 -2.345 15.487 1.00 7.38 C", & "ATOM 3 C GLY Z 1 -0.968 -3.008 14.344 1.00 4.89 C", & "ATOM 4 O GLY Z 1 0.258 -2.982 14.292 1.00 5.05 O", & "ATOM 5 HA2 GLY Z 1 -2.130 -1.405 15.135 1.00 0.00 H", & "ATOM 6 HA3 GLY Z 1 -2.511 -2.999 15.819 1.00 0.00 H", & "ATOM 7 H1 GLY Z 1 -1.364 -1.742 17.394 1.00 0.00 H", & "ATOM 8 H2 GLY Z 1 -0.150 -1.365 16.344 1.00 0.00 H", & "ATOM 9 H3 GLY Z 1 -0.334 -2.918 16.868 1.00 0.00 H", & "ATOM 10 N ASN Z 2 -1.721 -3.603 13.425 1.00 3.53 N", & "ATOM 11 CA ASN Z 2 -1.141 -4.323 12.291 1.00 1.85 C", & "ATOM 12 C ASN Z 2 -1.748 -3.900 10.968 1.00 3.00 C", & "ATOM 13 O ASN Z 2 -2.955 -3.683 10.873 1.00 3.99 O", & "ATOM 14 CB ASN Z 2 -1.353 -5.827 12.446 1.00 5.03 C", & "ATOM 15 CG ASN Z 2 -0.679 -6.391 13.683 1.00 5.08 C", & "ATOM 16 OD1 ASN Z 2 0.519 -6.202 13.896 1.00 6.10 O", & "ATOM 17 ND2 ASN Z 2 -1.448 -7.087 14.506 1.00 8.41 N", & "ATOM 18 H ASN Z 2 -2.726 -3.557 13.512 1.00 0.00 H", & "ATOM 19 HA ASN Z 2 -0.070 -4.123 12.263 1.00 0.00 H", & "ATOM 20 HB2 ASN Z 2 -0.945 -6.328 11.568 1.00 0.00 H", & "ATOM 21 HB3 ASN Z 2 -2.423 -6.029 12.503 1.00 0.00 H", & "ATOM 22 HD21 ASN Z 2 -2.427 -7.218 14.293 1.00 0.00 H", & "ATOM 23 HD22 ASN Z 2 -1.056 -7.487 15.346 1.00 0.00 H", & "ATOM 24 N LEU Z 3 -0.907 -3.803 9.944 1.00 3.47 N", & "ATOM 25 CA LEU Z 3 -1.388 -3.576 8.586 1.00 3.48 C", & "ATOM 26 C LEU Z 3 -0.783 -4.660 7.709 1.00 3.29 C", & "ATOM 27 O LEU Z 3 0.437 -4.788 7.643 1.00 3.80 O", & "ATOM 28 CB LEU Z 3 -0.977 -2.185 8.081 1.00 3.88 C", & "ATOM 29 CG LEU Z 3 -1.524 -1.669 6.736 1.00 8.66 C", & "ATOM 30 CD1 LEU Z 3 -1.225 -0.191 6.570 1.00 9.89 C", & "ATOM 31 CD2 LEU Z 3 -0.962 -2.409 5.541 1.00 13.56 C", & "ATOM 32 H LEU Z 3 0.086 -3.888 10.109 1.00 0.00 H", & "ATOM 33 HA LEU Z 3 -2.475 -3.661 8.568 1.00 0.00 H", & "ATOM 34 HB2 LEU Z 3 -1.284 -1.469 8.843 1.00 0.00 H", & "ATOM 35 HB3 LEU Z 3 0.111 -2.162 8.026 1.00 0.00 H", & "ATOM 36 HG LEU Z 3 -2.606 -1.798 6.737 1.00 0.00 H", & "ATOM 37 HD11 LEU Z 3 -1.623 0.359 7.423 1.00 0.00 H", & "ATOM 38 HD12 LEU Z 3 -1.691 0.173 5.654 1.00 0.00 H", & "ATOM 39 HD13 LEU Z 3 -0.147 -0.043 6.513 1.00 0.00 H", & "ATOM 40 HD21 LEU Z 3 -1.168 -3.475 5.643 1.00 0.00 H", & "ATOM 41 HD22 LEU Z 3 -1.429 -2.035 4.630 1.00 0.00 H", & "ATOM 42 HD23 LEU Z 3 0.115 -2.250 5.489 1.00 0.00 H", & "ATOM 43 N VAL Z 4 -1.635 -5.424 7.029 1.00 3.17 N", & "ATOM 44 CA VAL Z 4 -1.165 -6.460 6.119 1.00 3.61 C", & "ATOM 45 C VAL Z 4 -1.791 -6.230 4.755 1.00 5.31 C", & "ATOM 46 O VAL Z 4 -3.014 -6.209 4.620 1.00 7.31 O", & "ATOM 47 CB VAL Z 4 -1.567 -7.872 6.593 1.00 5.31 C", & "ATOM 48 CG1 VAL Z 4 -1.012 -8.934 5.633 1.00 6.73 C", & "ATOM 49 CG2 VAL Z 4 -1.083 -8.120 8.018 1.00 5.48 C", & "ATOM 50 H VAL Z 4 -2.628 -5.282 7.146 1.00 0.00 H", & "ATOM 51 HA VAL Z 4 -0.080 -6.402 6.034 1.00 0.00 H", & "ATOM 52 HB VAL Z 4 -2.655 -7.939 6.585 1.00 0.00 H", & "ATOM 53 HG11 VAL Z 4 -1.303 -9.926 5.980 1.00 0.00 H", & "ATOM 54 HG12 VAL Z 4 -1.414 -8.766 4.634 1.00 0.00 H", & "ATOM 55 HG13 VAL Z 4 0.075 -8.864 5.603 1.00 0.00 H", & "ATOM 56 HG21 VAL Z 4 -1.377 -9.121 8.333 1.00 0.00 H", & "ATOM 57 HG22 VAL Z 4 0.003 -8.032 8.053 1.00 0.00 H", & "ATOM 58 HG23 VAL Z 4 -1.529 -7.383 8.686 1.00 0.00 H", & "ATOM 59 N SER Z 5 -0.966 -6.052 3.736 1.00 7.53 N", & "ATOM 60 CA SER Z 5 -1.526 -5.888 2.407 1.00 11.48 C", & "ATOM 61 C SER Z 5 -1.207 -7.085 1.529 1.00 16.35 C", & "ATOM 62 O SER Z 5 -0.437 -7.976 1.902 1.00 14.00 O", & "ATOM 63 CB SER Z 5 -1.031 -4.596 1.767 1.00 13.36 C", & "ATOM 64 OG SER Z 5 0.361 -4.652 1.540 1.00 15.80 O", & "ATOM 65 OXT SER Z 5 -1.737 -7.178 0.429 1.00 17.09 O1-", & "ATOM 66 H SER Z 5 0.033 -6.031 3.880 1.00 0.00 H", & "ATOM 67 HA SER Z 5 -2.610 -5.822 2.504 1.00 0.00 H", & "ATOM 68 HB2 SER Z 5 -1.543 -4.449 0.816 1.00 0.00 H", & "ATOM 69 HB3 SER Z 5 -1.254 -3.759 2.428 1.00 0.00 H", & "ATOM 70 HG SER Z 5 0.653 -3.831 1.137 1.00 0.00 H", & "TER 71 SER Z 5", & "HETATM 72 O HOH Z 101 0.935 -5.175 16.502 1.00 18.83 O", & "HETATM 73 H1 HOH Z 101 0.794 -5.522 15.621 1.00 0.00 H", & "HETATM 74 H2 HOH Z 101 1.669 -4.561 16.489 1.00 0.00 H", & "HETATM 75 O HOH Z 102 0.691 -8.408 17.879 0.91 56.55 O", & "HETATM 76 H1 HOH Z 102 1.392 -8.125 18.466 0.91 0.00 H", & "HETATM 77 H2 HOH Z 102 0.993 -8.356 16.972 0.91 0.00 H", & "END" rewind(unit) call read_pdb(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 76, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%charge, 0.0_wp, "Total charge is not correct") if (allocated(error)) return end subroutine test_valid1_pdb subroutine test_valid2_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "HETATM 2463 CHA HEM A 154 9.596 -13.100 10.368 1.00 0.00 C", & "HETATM 2464 CHB HEM A 154 11.541 -10.200 7.336 1.00 0.00 C", & "HETATM 2465 CHC HEM A 154 9.504 -6.500 9.390 1.00 0.00 C", & "HETATM 2466 CHD HEM A 154 7.260 -9.300 12.422 1.00 0.00 C", & "HETATM 2467 C1A HEM A 154 10.383 -12.600 9.488 1.00 0.00 C", & "HETATM 2468 C2A HEM A 154 10.970 -13.500 8.607 1.00 0.00 C", & "HETATM 2469 C3A HEM A 154 11.537 -12.600 7.825 1.00 0.00 C", & "HETATM 2470 C4A HEM A 154 11.295 -11.300 8.020 1.00 0.00 C", & "HETATM 2471 CMA HEM A 154 12.628 -13.100 6.455 1.00 0.00 C", & "HETATM 2472 CAA HEM A 154 11.250 -15.000 8.705 1.00 0.00 C", & "HETATM 2473 CBA HEM A 154 9.870 -15.600 8.607 1.00 0.00 C", & "HETATM 2474 CGA HEM A 154 8.899 -14.700 7.531 1.00 0.00 C", & "HETATM 2475 O1A HEM A 154 8.337 -14.400 7.825 1.00 0.00 O", & "HETATM 2476 O2A HEM A 154 9.062 -14.700 7.238 1.00 0.00 O", & "HETATM 2477 C1B HEM A 154 11.178 -8.900 7.629 1.00 0.00 C", & "HETATM 2478 C2B HEM A 154 11.745 -7.800 6.847 1.00 0.00 C", & "HETATM 2479 C3B HEM A 154 11.020 -6.800 7.434 1.00 0.00 C", & "HETATM 2480 C4B HEM A 154 10.370 -7.200 8.607 1.00 0.00 C", & "HETATM 2481 CMB HEM A 154 12.615 -7.800 5.575 1.00 0.00 C", & "HETATM 2482 CAB HEM A 154 11.203 -5.300 7.042 1.00 0.00 C", & "HETATM 2483 CBB HEM A 154 11.911 -4.800 6.064 1.00 0.00 C", & "HETATM 2484 C1C HEM A 154 8.817 -6.900 10.270 1.00 0.00 C", & "HETATM 2485 C2C HEM A 154 8.130 -6.100 11.150 1.00 0.00 C", & "HETATM 2486 C3C HEM A 154 7.543 -6.900 12.031 1.00 0.00 C", & "HETATM 2487 C4C HEM A 154 7.805 -8.200 11.737 1.00 0.00 C", & "HETATM 2488 CMC HEM A 154 8.051 -4.600 11.053 1.00 0.00 C", & "HETATM 2489 CAC HEM A 154 6.414 -6.500 13.107 1.00 0.00 C", & "HETATM 2490 CBC HEM A 154 6.193 -5.100 13.204 1.00 0.00 C", & "HETATM 2491 C1D HEM A 154 7.843 -10.600 12.031 1.00 0.00 C", & "HETATM 2492 C2D HEM A 154 7.256 -11.700 12.911 1.00 0.00 C", & "HETATM 2493 C3D HEM A 154 8.101 -12.800 12.226 1.00 0.00 C", & "HETATM 2494 C4D HEM A 154 8.809 -12.300 11.248 1.00 0.00 C", & "HETATM 2495 CMD HEM A 154 6.427 -11.800 13.987 1.00 0.00 C", & "HETATM 2496 CAD HEM A 154 7.897 -14.200 12.715 1.00 0.00 C", & "HETATM 2497 CBD HEM A 154 8.085 -14.200 14.182 1.00 0.00 C", & "HETATM 2498 CGD HEM A 154 9.023 -15.500 14.476 1.00 0.00 C", & "HETATM 2499 O1D HEM A 154 8.898 -15.800 15.063 1.00 0.00 O", & "HETATM 2500 O2D HEM A 154 9.527 -15.600 13.987 1.00 0.00 O", & "HETATM 2501 NA HEM A 154 10.487 -11.300 8.999 1.00 0.00 N", & "HETATM 2502 NB HEM A 154 10.570 -8.600 8.607 1.00 0.00 N", & "HETATM 2503 NC HEM A 154 8.613 -8.200 10.759 1.00 0.00 N", & "HETATM 2504 ND HEM A 154 8.709 -10.900 11.248 1.00 0.00 N", & "HETATM 2505 FE HEM A 154 9.621 -9.800 9.781 1.00 0.00 Fe", & "HETATM 2506 HHA HEM A 154 9.526 -14.175 10.446 1.00 0.00 H", & "HETATM 2507 HHB HEM A 154 12.102 -10.334 6.423 1.00 0.00 H", & "HETATM 2508 HHC HEM A 154 9.433 -5.442 9.183 1.00 0.00 H", & "HETATM 2509 HHD HEM A 154 6.484 -9.203 13.167 1.00 0.00 H", & "HETATM 2510 HAA2 HEM A 154 11.721 -15.251 9.655 1.00 0.00 H", & "HETATM 2511 HAA3 HEM A 154 11.871 -15.329 7.871 1.00 0.00 H", & "HETATM 2512 HBA2 HEM A 154 9.950 -16.625 8.245 1.00 0.00 H", & "HETATM 2513 HBA3 HEM A 154 9.407 -15.602 9.594 1.00 0.00 H", & "HETATM 2514 HAB HEM A 154 10.678 -4.585 7.657 1.00 0.00 H", & "HETATM 2515 HAC2 HEM A 154 5.478 -6.978 12.818 1.00 0.00 H", & "HETATM 2516 HAC3 HEM A 154 6.713 -6.877 14.085 1.00 0.00 H", & "HETATM 2517 HAD2 HEM A 154 6.889 -14.534 12.471 1.00 0.00 H", & "HETATM 2518 HAD3 HEM A 154 8.627 -14.862 12.250 1.00 0.00 H", & "HETATM 2519 HBD2 HEM A 154 8.582 -13.286 14.506 1.00 0.00 H", & "HETATM 2520 HBD3 HEM A 154 7.124 -14.306 14.686 1.00 0.00 H", & "HETATM 2521 HBB1 HEM A 154 12.463 -5.456 5.407 1.00 0.00 H", & "HETATM 2522 HBB2 HEM A 154 11.944 -3.731 5.913 1.00 0.00 H", & "HETATM 2523 HMD1 HEM A 154 5.952 -10.917 14.388 1.00 0.00 H", & "HETATM 2524 HMD2 HEM A 154 6.244 -12.763 14.439 1.00 0.00 H", & "HETATM 2525 HMA1 HEM A 154 12.066 -13.093 5.521 1.00 0.00 H", & "HETATM 2526 HMA2 HEM A 154 13.462 -12.402 6.382 1.00 0.00 H", & "HETATM 2527 HMA3 HEM A 154 13.009 -14.104 6.642 1.00 0.00 H", & "HETATM 2528 HMB1 HEM A 154 13.413 -7.065 5.680 1.00 0.00 H", & "HETATM 2529 HMB2 HEM A 154 11.998 -7.545 4.713 1.00 0.00 H", & "HETATM 2530 HMB3 HEM A 154 13.048 -8.790 5.431 1.00 0.00 H", & "HETATM 2531 HMC1 HEM A 154 8.716 -4.251 10.263 1.00 0.00 H", & "HETATM 2532 HMC2 HEM A 154 8.353 -4.158 12.003 1.00 0.00 H", & "HETATM 2533 HMC3 HEM A 154 7.027 -4.304 10.824 1.00 0.00 H", & "HETATM 2534 HBC1 HEM A 154 5.472 -4.900 13.996 1.00 0.00 H", & "HETATM 2535 HBC2 HEM A 154 5.804 -4.727 12.256 1.00 0.00 H", & "HETATM 2536 HBC3 HEM A 154 7.133 -4.599 13.434 1.00 0.00 H", & "END" rewind(unit) call read_pdb(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 74, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 5, "Number of species does not match") if (allocated(error)) return call check(error, struc%charge, 0.0_wp, "Total charge is not correct") if (allocated(error)) return end subroutine test_valid2_pdb subroutine test_valid3_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "ATOM 1 N PCA A 1 -0.169 -16.525 -1.918 1.00 39.42 9WGA 334", & "ATOM 2 CA PCA A 1 -1.347 -16.464 -2.767 1.00 38.75 9WGA 335", & "ATOM 3 C PCA A 1 -2.629 -16.172 -2.059 1.00 36.17 9WGA 336", & "ATOM 4 O PCA A 1 -3.696 -16.128 -2.783 1.00 37.04 9WGA 337", & "ATOM 5 CB PCA A 1 -1.231 -17.791 -3.531 1.00 39.80 9WGA 338", & "ATOM 6 CG PCA A 1 -0.711 -18.699 -2.396 1.00 40.00 9WGA 339", & "ATOM 7 CD PCA A 1 0.259 -17.781 -1.710 1.00 40.78 9WGA 340", & "ATOM 8 OE PCA A 1 1.275 -18.105 -1.083 1.00 41.14 9WGA 341", & "ATOM 9 2H PCA A 1 0.636 -16.724 -2.477 1.00 39.42 9WGA H + new", & "ATOM 10 HA PCA A 1 -1.381 -15.601 -3.448 1.00 38.75 9WGA H new", & "ATOM 11 1HB PCA A 1 -2.196 -18.131 -3.935 1.00 39.80 9WGA H new", & "ATOM 12 2HB PCA A 1 -0.531 -17.731 -4.378 1.00 39.80 9WGA H new", & "ATOM 13 1HG PCA A 1 -1.518 -19.028 -1.724 1.00 40.00 9WGA H new", & "ATOM 14 2HG PCA A 1 -0.223 -19.607 -2.781 1.00 40.00 9WGA H new", & "TER 15 PCA A 1 9WGA1493", & "END 9WGA3299" rewind(unit) call read_pdb(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 14, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%charge, 0.0_wp, "Total charge is not correct") if (allocated(error)) return end subroutine test_valid3_pdb subroutine test_valid4_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "ATOM 1 N GLY Z 1 -0.821 -2.072 16.609 1.00 9.93 N1+", & "ANISOU 1 N GLY Z 1 1184 1952 638 314 -191 -326 N", & "ATOM 2 CA GLY Z 1 -1.705 -2.345 15.487 1.00 7.38 C", & "ANISOU 2 CA GLY Z 1 957 1374 472 279 -124 -261 C", & "ATOM 3 C GLY Z 1 -0.968 -3.008 14.344 1.00 4.89 C", & "ANISOU 3 C GLY Z 1 899 614 343 211 112 -106 C", & "ATOM 4 O GLY Z 1 0.258 -2.982 14.292 1.00 5.05 O", & "ANISOU 4 O GLY Z 1 839 595 485 -11 -7 -180 O", & "ATOM 5 HA2 GLY Z 1 -2.130 -1.405 15.135 1.00 0.00 H", & "ATOM 6 HA3 GLY Z 1 -2.511 -2.999 15.819 1.00 0.00 H", & "ATOM 7 H1 GLY Z 1 -1.364 -1.742 17.394 1.00 0.00 H", & "ATOM 8 H2 GLY Z 1 -0.150 -1.365 16.344 1.00 0.00 H", & "ATOM 9 H3 GLY Z 1 -0.334 -2.918 16.868 1.00 0.00 H", & "ATOM 10 H GLY Z 1 -1.141 -4.323 12.291 1.00 1.85 H", & "TER 11 GLY Z 1", & "END" rewind(unit) call read_pdb(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 10, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return call check(error, struc%charge, 1.0_wp, "Total charge is not correct") if (allocated(error)) return end subroutine test_valid4_pdb subroutine test_invalid1_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "ATOM 1 N GLY Z 1 -0.821 -2.072 16.609 1.00 9.93 N1+", & "ATOM 2 CA GLY Z 1 -1.705 -2.345 15.487 1.00 7.38 C", & "ATOM 3 C GLY Z 1 -0.968 -3.008 14.344 1.00 4.89 C", & "ATOM 4 O GLY Z 1 0.258 -2.982 14.292 1.00 5.05 O", & "ATOM 5 HA2 GLY Z 1 -2.130 -1.405 15.135 1.00 0.00 H", & "ATOM 6 HA3 GLY Z 1 -2.511 -2.999 15.819 1.00 0.00 H", & "ATOM 7 H1 GLY Z 1 -1.364 -1.742 17.394 1.00 0.00 H", & "ATOM 8 H2 GLY Z 1 -0.150 -1.365 16.344 1.00 0.00 H", & "ATOM 9 H3 GLY Z 1 -0.334 -2.918 16.868 1.00 0.00 H", & "ATOM 10 N ASN Z 2 -1.721 -3.603 13.425 1.00 3.53 N", & "ATOM 11 CA ASN Z 2 -1.141 -4.323 12.291 1.00 1.85 C", & "ATOM 12 C ASN Z 2 -1.748 -3.900 10.968 1.00 3.00 C", & "ATOM 13 O ASN Z 2 -2.955 -3.683 10.873 1.00 3.99 O", & "ATOM 14 CB ASN Z 2 -1.353 -5.827 12.446 1.00 5.03 C", & "ATOM 15 CG ASN Z 2 -0.679 -6.391 13.683 1.00 5.08 C", & "ATOM 16 OD1 ASN Z 2 0.519 -6.202 13.896 1.00 6.10 O", & "ATOM 17 ND2 ASN Z 2 -1.448 -7.087 14.506 1.00 8.41 N", & "ATOM 18 H ASN Z 2 -2.726 -3.557 13.512 1.00 0.00 H", & "ATOM 19 HA ASN Z 2 -0.070 -4.123 12.263 1.00 0.00 H", & "ATOM 20 HB2 ASN Z 2 -0.945 -6.328 11.568 1.00 0.00 H", & "ATOM 21 HB3 ASN Z 2 a.bcd -6.029 12.503 1.00 0.00 H", & "ATOM 22 HD21 ASN Z 2 -2.427 -7.218 14.293 1.00 0.00 H", & "ATOM 23 HD22 ASN Z 2 -1.056 -7.487 15.346 1.00 0.00 H", & "ATOM 24 N LEU Z 3 -0.907 -3.803 9.944 1.00 3.47 N", & "ATOM 25 CA LEU Z 3 -1.388 -3.576 8.586 1.00 3.48 C", & "ATOM 26 C LEU Z 3 -0.783 -4.660 7.709 1.00 3.29 C", & "ATOM 27 O LEU Z 3 0.437 -4.788 7.643 1.00 3.80 O", & "ATOM 28 CB LEU Z 3 -0.977 -2.185 8.081 1.00 3.88 C", & "ATOM 29 CG LEU Z 3 -1.524 -1.669 6.736 1.00 8.66 C", & "ATOM 30 CD1 LEU Z 3 -1.225 -0.191 6.570 1.00 9.89 C", & "ATOM 31 CD2 LEU Z 3 -0.962 -2.409 5.541 1.00 13.56 C", & "ATOM 32 H LEU Z 3 0.086 -3.888 10.109 1.00 0.00 H", & "ATOM 33 HA LEU Z 3 -2.475 -3.661 8.568 1.00 0.00 H", & "ATOM 34 HB2 LEU Z 3 -1.284 -1.469 8.843 1.00 0.00 H", & "ATOM 35 HB3 LEU Z 3 0.111 -2.162 8.026 1.00 0.00 H", & "ATOM 36 HG LEU Z 3 -2.606 -1.798 6.737 1.00 0.00 H", & "ATOM 37 HD11 LEU Z 3 -1.623 0.359 7.423 1.00 0.00 H", & "ATOM 38 HD12 LEU Z 3 -1.691 0.173 5.654 1.00 0.00 H", & "ATOM 39 HD13 LEU Z 3 -0.147 -0.043 6.513 1.00 0.00 H", & "ATOM 40 HD21 LEU Z 3 -1.168 -3.475 5.643 1.00 0.00 H", & "ATOM 41 HD22 LEU Z 3 -1.429 -2.035 4.630 1.00 0.00 H", & "ATOM 42 HD23 LEU Z 3 0.115 -2.250 5.489 1.00 0.00 H", & "ATOM 43 N VAL Z 4 -1.635 -5.424 7.029 1.00 3.17 N", & "ATOM 44 CA VAL Z 4 -1.165 -6.460 6.119 1.00 3.61 C", & "ATOM 45 C VAL Z 4 -1.791 -6.230 4.755 1.00 5.31 C", & "ATOM 46 O VAL Z 4 -3.014 -6.209 4.620 1.00 7.31 O", & "ATOM 47 CB VAL Z 4 -1.567 -7.872 6.593 1.00 5.31 C", & "ATOM 48 CG1 VAL Z 4 -1.012 -8.934 5.633 1.00 6.73 C", & "ATOM 49 CG2 VAL Z 4 -1.083 -8.120 8.018 1.00 5.48 C", & "ATOM 50 H VAL Z 4 -2.628 -5.282 7.146 1.00 0.00 H", & "ATOM 51 HA VAL Z 4 -0.080 -6.402 6.034 1.00 0.00 H", & "ATOM 52 HB VAL Z 4 -2.655 -7.939 6.585 1.00 0.00 H", & "ATOM 53 HG11 VAL Z 4 -1.303 -9.926 5.980 1.00 0.00 H", & "ATOM 54 HG12 VAL Z 4 -1.414 -8.766 4.634 1.00 0.00 H", & "ATOM 55 HG13 VAL Z 4 0.075 -8.864 5.603 1.00 0.00 H", & "ATOM 56 HG21 VAL Z 4 -1.377 -9.121 8.333 1.00 0.00 H", & "ATOM 57 HG22 VAL Z 4 0.003 -8.032 8.053 1.00 0.00 H", & "ATOM 58 HG23 VAL Z 4 -1.529 -7.383 8.686 1.00 0.00 H", & "ATOM 59 N SER Z 5 -0.966 -6.052 3.736 1.00 7.53 N", & "ATOM 60 CA SER Z 5 -1.526 -5.888 2.407 1.00 11.48 C", & "ATOM 61 C SER Z 5 -1.207 -7.085 1.529 1.00 16.35 C", & "ATOM 62 O SER Z 5 -0.437 -7.976 1.902 1.00 14.00 O", & "ATOM 63 CB SER Z 5 -1.031 -4.596 1.767 1.00 13.36 C", & "ATOM 64 OG SER Z 5 0.361 -4.652 1.540 1.00 15.80 O", & "ATOM 65 OXT SER Z 5 -1.737 -7.178 0.429 1.00 17.09 O1-", & "ATOM 66 H SER Z 5 0.033 -6.031 3.880 1.00 0.00 H", & "ATOM 67 HA SER Z 5 -2.610 -5.822 2.504 1.00 0.00 H", & "ATOM 68 HB2 SER Z 5 -1.543 -4.449 0.816 1.00 0.00 H", & "ATOM 69 HB3 SER Z 5 -1.254 -3.759 2.428 1.00 0.00 H", & "ATOM 70 HG SER Z 5 0.653 -3.831 1.137 1.00 0.00 H", & "TER 71 SER Z 5", & "HETATM 72 O HOH Z 101 0.935 -5.175 16.502 1.00 18.83 O", & "HETATM 73 H1 HOH Z 101 0.794 -5.522 15.621 1.00 0.00 H", & "HETATM 74 H2 HOH Z 101 1.669 -4.561 16.489 1.00 0.00 H", & "HETATM 75 O HOH Z 102 0.691 -8.408 17.879 0.91 56.55 O", & "HETATM 76 H1 HOH Z 102 1.392 -8.125 18.466 0.91 0.00 H", & "HETATM 77 H2 HOH Z 102 0.993 -8.356 16.972 0.91 0.00 H", & "END" rewind(unit) call read_pdb(struc, unit, error) close(unit) end subroutine test_invalid1_pdb subroutine test_invalid2_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "HETATM 2463 CHA HEM A 154 9.596 -13.100 10.368 1.00 0.00 C", & "HETATM 2464 CHB HEM A 154 11.541 -10.200 7.336 1.00 0.00 C", & "HETATM 2465 CHC HEM A 154 9.504 -6.500 9.390 1.00 0.00 C", & "HETATM 2466 CHD HEM A 154 7.260 -9.300 12.422 1.00 0.00 C", & "HETATM 2467 C1A HEM A 154 10.383 -12.600 9.488 1.00 0.00 C", & "HETATM 2468 C2A HEM A 154 10.970 -13.500 8.607 1.00 0.00 C", & "HETATM 2469 C3A HEM A 154 11.537 -12.600 7.825 1.00 0.00 C", & "HETATM 2470 C4A HEM A 154 11.295 -11.300 8.020 1.00 0.00 C", & "HETATM 2471 CMA HEM A 154 12.628 -13.100 6.455 1.00 0.00 C", & "HETATM 2472 CAA HEM A 154 11.250 -15.000 8.705 1.00 0.00 C", & "HETATM 2473 CBA HEM A 154 9.870 -15.600 8.607 1.00 0.00 C", & "HETATM 2474 CGA HEM A 154 8.899 -14.700 7.531 1.00 0.00 C", & "HETATM 2475 O1A HEM A 154 8.337 -14.400 7.825 1.00 0.00 O", & "HETATM 2476 O2A HEM A 154 9.062 -14.700 7.238 1.00 0.00 O", & "HETATM 2477 C1B HEM A 154 11.178 -8.900 7.629 1.00 0.00 C", & "HETATM 2478 C2B HEM A 154 11.745 -7.800 6.847 1.00 0.00 C", & "HETATM 2479 C3B HEM A 154 11.020 -6.800 7.434 1.00 0.00 C", & "HETATM 2480 C4B HEM A 154 10.370 -7.200 8.607 1.00 0.00 C", & "HETATM 2481 CMB HEM A 154 12.615 -7.800 5.575 1.00 0.00 C", & "HETATM 2482 CAB HEM A 154 11.203 -5.300 7.042 1.00 0.00 C", & "HETATM 2483 CBB HEM A 154 11.911 -4.800 6.064 1.00 0.00 C", & "HETATM 2484 C1C HEM A 154 8.817 -6.900 10.270 1.00 0.00 C", & "HETATM 2485 C2C HEM A 154 8.130 -6.100 11.150 1.00 0.00 C", & "HETATM 2486 C3C HEM A 154 7.543 -6.900 12.031 1.00 0.00 C", & "HETATM 2487 C4C HEM A 154 7.805 -8.200 11.737 1.00 0.00 C", & "HETATM 2488 CMC HEM A 154 8.051 -4.600 11.053 1.00 0.00 C", & "HETATM 2489 CAC HEM A 154 6.414 -6.500 13.107 1.00 0.00 C", & "HETATM 2490 CBC HEM A 154 6.193 -5.100 13.204 1.00 0.00 C", & "HETATM 2491 C1D HEM A 154 7.843 -10.600 12.031 1.00 0.00 C", & "HETATM 2492 C2D HEM A 154 7.256 -11.700 12.911 1.00 0.00 C", & "HETATM 2493 C3D HEM A 154 8.101 -12.800 12.226 1.00 0.00 C", & "HETATM 2494 C4D HEM A 154 8.809 -12.300 11.248 1.00 0.00 C", & "HETATM 2495 CMD HEM A 154 6.427 -11.800 13.987 1.00 0.00 C", & "HETATM 2496 CAD HEM A 154 7.897 -14.200 12.715 1.00 0.00 C", & "HETATM 2497 CBD HEM A 154 8.085 -14.200 14.182 1.00 0.00 C", & "HETATM 2498 CGD HEM A 154 9.023 -15.500 14.476 1.00 0.00 C", & "HETATM 2499 O1D HEM A 154 8.898 -15.800 15.063 1.00 0.00 O", & "HETATM 2500 O2D HEM A 154 9.527 -15.600 13.987 1.00 0.00 O", & "HETATM 2501 NA HEM A 154 10.487 -11.300 8.999 1.00 0.00 N", & "HETATM 2502 NB HEM A 154 10.570 -8.600 8.607 1.00 0.00 N", & "HETATM 2503 NC HEM A 154 8.613 -8.200 10.759 1.00 0.00 N", & "HETATM 2504 ND HEM A 154 8.709 -10.900 11.248 1.00 0.00 N", & "HETATM 2505 FE HEM A 154 9.621 -9.800 9.781 1.00 0.00 Fe", & "HETATM 2506 HHA HEM A 154 9.526 -14.175 10.446 1.00 0.00 H", & "HETATM 2507 HHB HEM A 154 12.102 -10.334 6.423 1.00 0.00 H", & "HETATM 2508 HHC HEM A 154 9.433 -5.442 9.183 1.00 0.00 H", & "HETATM 2509 HHD HEM A 154 6.484 -9.203 13.167 1.00 0.00 H", & "HETATM 2510 HAA2 HEM A 154 11.721 -15.251 9.655 1.00 0.00 H", & "HETATM 2511 HAA3 HEM A 154 11.871 -15.329 7.871 1.00 0.00 H", & "HETATM 2512 HBA2 HEM A 154 9.950 -16.625 8.245 1.00 0.00 H", & "HETATM 2513 HBA3 HEM A 154 9.407 -15.602 9.594 1.00 0.00 H", & "HETATM 2514 HAB HEM A 154 10.678 -4.585 7.657 1.00 0.00 H", & "HETATM 2515 HAC2 HEM A 154 5.478 -6.978 12.818 1.00 0.00 H", & "HETATM 2516 HAC3 HEM A 154 6.713 -6.877 14.085 1.00 0.00 H", & "HETATM 2517 HAD2 HEM A 154 6.889 -14.534 12.471 1.00 0.00 H", & "HETATM 2518 HAD3 HEM A 154 8.627 -14.862 12.250 1.00 0.00 H", & "HETATM 2519 HBD2 HEM A 154 8.582 -13.286 14.506 1.00 0.00 H", & "HETATM 2520 HBD3 HEM A 154 7.124 -14.306 14.686 1.00 0.00 H", & "HETATM 2521 HBB1 HEM A 154 12.463 -5.456 5.407 1.00 0.00 H", & "HETATM 2522 HBB2 HEM A 154 11.944 -3.731 5.913 1.00 0.00 H", & "HETATM 2523 HMD1 HEM A 154 5.952 -10.917 14.388 1.00 0.00 H", & "HETATM 2524 HMD2 HEM A 154 6.244 -12.763 14.439 1.00 0.00 H", & "HETATM 2525 HMA1 HEM A 154 12.066 -13.093 5.521 1.00 0.00 H", & "HETATM 2526 HMA2 HEM A 154 13.462 -12.402 6.382 1.00 0.00 H", & "HETATM 2527 HMA3 HEM A 154 13.009 -14.104 6.642 1.00 0.00 H", & "HETATM 2528 HMB1 HEM A 154 13.413 -7.065 5.680 1.00 0.00 H", & "HETATM 2529 HMB2 HEM A 154 11.998 -7.545 4.713 1.00 0.00 H", & "HETATM 2530 HMB3 HEM A 154 13.048 -8.790 5.431 1.00 0.00 H", & "HETATM 2531 HMC1 HEM A 154 8.716 -4.251 10.263 1.00 0.00 H", & "HETATM 2532 HMC2 HEM A 154 8.353 -4.158 12.003 1.00 0.00 H", & "HETATM 2533 HMC3 HEM A 154 7.027 -4.304 10.824 1.00 0.00 H", & "HETATM 2534 HBC1 HEM A 154 5.472 -4.900 13.996 1.00 0.00 H", & "HETATM 2535 HBC2 HEM A 154 5.804 -4.727 12.256 1.00 0.00 H", & "HETATM 2536 HBC3 HEM A 154 7.133 -4.599 13.434 1.00 0.00 H", & "END" rewind(unit) call read_pdb(struc, unit, error) close(unit) end subroutine test_invalid2_pdb subroutine test_invalid3_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "ATOM 1 N GLY Z 1 -0.821 -2.072 16.609 1.00 9.93 N1+", & "ANISOU 1 N GLY Z 1 1184 1952 638 314 -191 -326 N", & "ATOM 2 CA GLY Z 1 -1.705 -2.345 15.487 1.00 7.38 C", & "ANISOU 2 CA GLY Z 1 957 1374 472 279 -124 -261 C", & "ATOM 3 C GLY Z 1 -0.968 -3.008 14.344 1.00 4.89 C", & "ANISOU 3 C GLY Z 1 899 614 343 211 112 -106 C", & "ATOM 4 O GLY Z 1 0.258 -2.982 14.292 1.00 5.05 O", & "ANISOU 4 O GLY Z 1 839 595 485 -11 -7 -180 O", & "ATOM 5 HA2 GLY Z 1 -2.130 -1.405 15.135 1.00 0.00 H", & "ATOM 6 HA3 GLY Z 1 -2.511 -2.999 15.819 1.00 0.00 H", & "ATOM 7 H1 GLY Z 1 -1.364 -1.742 17.394 1.00 0.00 H", & "ATOM 8 H2 GLY Z 1 -0.150 -1.365 16.344 1.00 0.00 H", & "ATOM 9 H3 GLY Z 1 -0.334 -2.918 16.868 1.00 0.00 H", & "ATOM 10 X GLY Z 1 -1.141 -4.323 12.291 1.00 1.85 X", & "TER 11 GLY Z 1", & "END" rewind(unit) call read_pdb(struc, unit, error) close(unit) end subroutine test_invalid3_pdb end module test_read_pdb mctc-lib-0.3.2/test/test_read_qchem.f90000066400000000000000000000221311466406626700176540ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_qchem use mctc_env, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_qchem use mctc_io_structure implicit none private public :: collect_read_qchem contains !> Collect all exported unit tests subroutine collect_read_qchem(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-qchem", test_valid1_qchem), & & new_unittest("valid2-qchem", test_valid2_qchem), & & new_unittest("valid3-qchem", test_valid3_qchem), & & new_unittest("invalid1-qchem", test_invalid1_qchem, should_fail=.true.), & & new_unittest("invalid2-qchem", test_invalid2_qchem, should_fail=.true.), & & new_unittest("invalid3-qchem", test_invalid3_qchem, should_fail=.true.), & & new_unittest("invalid4-qchem", test_invalid4_qchem, should_fail=.true.), & & new_unittest("invalid5-qchem", test_invalid5_qchem, should_fail=.true.) & & ] end subroutine collect_read_qchem subroutine test_valid1_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$molecule", & " 0 1", & " 8 0.000000 0.000000 -0.212195", & " 1 1.370265 0.000000 0.848778", & " 1 -1.370265 0.000000 0.848778", & "$end" rewind(unit) call read_qchem(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_qchem subroutine test_valid2_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & "$molecule", & " 0 1", & " O 0.000000 0.000000 -0.212195", & " H 1.370265 0.000000 0.848778", & " H -1.370265 0.000000 0.848778", & "$end" rewind(unit) call read_qchem(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_qchem subroutine test_valid3_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$MOLECULE", & "0 1", & "c 1.07317 0.04885 -0.07573", & "n 2.51365 0.01256 -0.07580", & "c 3.35199 1.09592 -0.07533", & "n 4.61898 0.73028 -0.07549", & "c 4.57907 -0.63144 -0.07531", & "c 3.30131 -1.10256 -0.07524", & "c 2.98068 -2.48687 -0.07377", & "o 1.82530 -2.90038 -0.07577", & "n 4.11440 -3.30433 -0.06936", & "c 5.45174 -2.85618 -0.07235", & "o 6.38934 -3.65965 -0.07232", & "n 5.66240 -1.47682 -0.07487", & "c 7.00947 -0.93648 -0.07524", & "c 3.92063 -4.74093 -0.06158", & "h 0.73398 1.08786 -0.07503", & "h 0.71239 -0.45698 0.82335", & "h 0.71240 -0.45580 -0.97549", & "h 2.99301 2.11762 -0.07478", & "h 7.76531 -1.72634 -0.07591", & "h 7.14864 -0.32182 0.81969", & "h 7.14802 -0.32076 -0.96953", & "h 2.86501 -5.02316 -0.05833", & "h 4.40233 -5.15920 0.82837", & "h 4.40017 -5.16929 -0.94780", & "$END" rewind(unit) call read_qchem(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_qchem subroutine test_invalid1_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$molecule", & " 0 1", & "C -0.0090 -0.0157 -0.0000", & "C -0.7131 1.2038 -0.0000", & "C 1.3990 -0.0157 -0.0000", & "C -0.0090 2.4232 -0.0000", & "C 2.1031 1.2038 -0.0000", & "C 1.3990 2.4232 0.0000", & "hh -0.5203 -0.9011 -0.0000", & "hh -1.7355 1.2038 0.0000", & "hh 1.9103 -0.9011 0.0000", & "H -0.5203 3.3087 0.0000", & "H 3.1255 1.2038 0.0000", & "H 1.9103 3.3087 -0.0000", & "$end" rewind(unit) call read_qchem(struc, unit, error) close(unit) end subroutine test_invalid1_qchem subroutine test_invalid2_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$molecule", & "24", & "c 1.07317 0.04885 -0.07573", & "n 2.51365 0.01256 -0.07580", & "c 3.35199 1.09592 -0.07533", & "n 4.61898 0.73028 -0.07549", & "c 4.57907 -0.63144 -0.07531", & "c 3.30131 -1.10256 -0.07524", & "c 2.98068 -2.48687 -0.07377", & "o 1.82530 -2.90038 -0.07577", & "n 4.11440 -3.30433 -0.06936", & "c 5.45174 -2.85618 -0.07235", & "o 6.38934 -3.65965 -0.07232", & "n 5.66240 -1.47682 -0.07487", & "c 7.00947 -0.93648 -0.07524", & "c 3.92063 -4.74093 -0.06158", & "h 0.73398 1.08786 -0.07503", & "h 0.71239 -0.45698 0.82335", & "h 0.71240 -0.45580 -0.97549", & "h 2.99301 2.11762 -0.07478", & "h 7.76531 -1.72634 -0.07591", & "h 7.14864 -0.32182 0.81969", & "h 7.14802 -0.32076 -0.96953", & "h 2.86501 -5.02316 -0.05833", & "h 4.40233 -5.15920 0.82837", & "h 4.40017 -5.16929 -0.94780", & "$end" rewind(unit) call read_qchem(struc, unit, error) close(unit) end subroutine test_invalid2_qchem subroutine test_invalid3_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$molecule", & " 0 1", & "C -0.0090 -0.0157 -0.0000", & "C -0.7131 1.2038 -0.0000", & "C 1.3990 -0.0157 -0.0000", & "C -0.0090 2.4232 -0.0000", & "C 2.1031 1.2038 -0.0000", & "C 1.3990 2.4232 0.0000", & "H -0.5203 -0.9011 -0.0000", & "H -1.7355 1.2038 0.0000", & "H 1.9103 -0.9011 0.0000", & "H -0.5203 3.3087 0.0000", & "H 3.1255 1.2038 0.0000", & "H 1.9103 3.3087 -0.0000" rewind(unit) call read_qchem(struc, unit, error) close(unit) end subroutine test_invalid3_qchem subroutine test_invalid4_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$mol", & " 0 1", & " 1 0 0 0", & "$end" rewind(unit) call read_qchem(struc, unit, error) close(unit) end subroutine test_invalid4_qchem subroutine test_invalid5_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$molecule", & " 0 1", & "C ****** ****** 0.0000", & "C ****** 1.2038 0.0000", & "C 1.3990 ****** 0.0000", & "C ****** 2.4232 0.0000", & "C 2.1031 1.2038 0.0000", & "C 1.3990 2.4232 0.0000", & "H ****** ****** 0.0000", & "H ****** 1.2038 0.0000", & "H 1.9103 ****** 0.0000", & "H ****** 3.3087 0.0000", & "H 3.1255 1.2038 0.0000", & "H 1.9103 3.3087 0.0000", & "$end" rewind(unit) call read_qchem(struc, unit, error) close(unit) end subroutine test_invalid5_qchem end module test_read_qchem mctc-lib-0.3.2/test/test_read_qcschema.f90000066400000000000000000000377751466406626700203670ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_qcschema use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_qcschema use mctc_io_structure use mctc_version, only : get_mctc_feature implicit none private public :: collect_read_qcschema contains !> Collect all exported unit tests subroutine collect_read_qcschema(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) logical :: with_json with_json = get_mctc_feature("json") testsuite = [ & & new_unittest("valid1-qcschema", test_valid1_qcschema, should_fail=.not.with_json), & & new_unittest("valid2-qcschema", test_valid2_qcschema, should_fail=.not.with_json), & & new_unittest("invalid1-qcschema", test_invalid1_qcschema, should_fail=.true.), & & new_unittest("invalid2-qcschema", test_invalid2_qcschema, should_fail=.true.), & & new_unittest("invalid3-qcschema", test_invalid3_qcschema, should_fail=.true.), & & new_unittest("invalid4-qcschema", test_invalid4_qcschema, should_fail=.true.), & & new_unittest("invalid5-qcschema", test_invalid5_qcschema, should_fail=.true.), & & new_unittest("invalid6-qcschema", test_invalid6_qcschema, should_fail=.true.) & & ] end subroutine collect_read_qcschema subroutine test_valid1_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 1,', & ' "molecule": {', & ' "geometry": [', & ' 0.0, 0.0000, -0.1294,', & ' 0.0, -1.4941, 1.0274,', & ' 0.0, 1.4941, 1.0274', & ' ],', & ' "symbols": ["O", "H", "H"],', & ' "comment": "Water molecule"', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "Water molecule") if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_qcschema subroutine test_valid2_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 1,', & ' "schema_name": "qcschema_input",', & ' "driver": "energy",', & ' "model": {', & ' "method": "xtb",', & ' "basis": null', & ' },', & ' "molecule": {', & ' "schema_version": 2,', & ' "schema_name": "qcschema_molecule",', & ' "provenance": {', & ' "creator": "mctc-lib",', & ' "version": "0.2.3",', & ' "routine": "mctc_io_write_qcschema::write_qcschema"', & ' },', & ' "symbols": [', & ' "C", "C", "C", "C", "C", "C", "H", "H", "H", "H", "H", "H",', & ' "H", "H", "H", "H", "H", "C", "C", "C", "C", "C", "C", "H",', & ' "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H",', & ' "H", "H"', & ' ],', & ' "geometry": [', & ' 1.1910941154998063E+00, 8.0445623507578545E-01, 0.0000000000000000E+00,', & ' 3.6246828858324265E+00,-7.2565467293657882E-01, 0.0000000000000000E+00,', & ' 6.0068711168320394E+00, 8.8306882464391478E-01, 0.0000000000000000E+00,', & ' 8.4393260517381972E+00,-6.4779797365275837E-01, 0.0000000000000000E+00,', & ' 1.0824537843875046E+01, 9.5827990793265394E-01, 0.0000000000000000E+00,', & ' 1.3237906549102401E+01,-5.9564154403544178E-01, 0.0000000000000000E+00,', & ' 1.4916738870552548E+01, 5.9753126974621407E-01, 0.0000000000000000E+00,', & ' 1.3341085572910570E+01,-1.8126249017728293E+00,-1.6605019820556557E+00,', & ' 1.3341085572910570E+01,-1.8126249017728293E+00, 1.6605019820556557E+00,', & ' 1.0802428053059009E+01, 2.2054988770423987E+00,-1.6484077375067128E+00,', & ' 1.0802428053059009E+01, 2.2054988770423987E+00, 1.6484077375067128E+00,', & ' 8.4618137876963875E+00,-1.8965287233311212E+00, 1.6491636277910218E+00,', & ' 8.4618137876963875E+00,-1.8965287233311212E+00,-1.6491636277910218E+00,', & ' 5.9874069420110843E+00, 2.1312326566090456E+00,-1.6493526003620989E+00,', & ' 5.9874069420110843E+00, 2.1312326566090456E+00, 1.6493526003620989E+00,', & ' 3.6452808960798451E+00,-1.9740074774727869E+00, 1.6491636277910218E+00,', & ' 3.6452808960798451E+00,-1.9740074774727869E+00,-1.6491636277910218E+00,', & ' -1.1910941154998063E+00,-8.0445623507578545E-01, 0.0000000000000000E+00,', & ' -3.6246828858324265E+00, 7.2565467293657882E-01, 0.0000000000000000E+00,', & ' -6.0068711168320394E+00,-8.8306882464391478E-01, 0.0000000000000000E+00,', & ' -8.4393260517381972E+00, 6.4779797365275837E-01, 0.0000000000000000E+00,', & ' -1.0824537843875046E+01,-9.5827990793265394E-01, 0.0000000000000000E+00,', & ' -1.3237906549102401E+01, 5.9564154403544178E-01, 0.0000000000000000E+00,', & ' -1.4916738870552548E+01,-5.9753126974621407E-01, 0.0000000000000000E+00,', & ' -1.3341085572910570E+01, 1.8126249017728293E+00, 1.6605019820556557E+00,', & ' -1.3341085572910570E+01, 1.8126249017728293E+00,-1.6605019820556557E+00,', & ' -1.0802428053059009E+01,-2.2054988770423987E+00,-1.6484077375067128E+00,', & ' -1.0802428053059009E+01,-2.2054988770423987E+00, 1.6484077375067128E+00,', & ' -8.4618137876963875E+00, 1.8965287233311212E+00, 1.6491636277910218E+00,', & ' -8.4618137876963875E+00, 1.8965287233311212E+00,-1.6491636277910218E+00,', & ' -5.9874069420110843E+00,-2.1312326566090456E+00,-1.6493526003620989E+00,', & ' -5.9874069420110843E+00,-2.1312326566090456E+00, 1.6493526003620989E+00,', & ' -3.6452808960798451E+00, 1.9740074774727869E+00,-1.6491636277910218E+00,', & ' -3.6452808960798451E+00, 1.9740074774727869E+00, 1.6491636277910218E+00,', & ' -1.1706850778234652E+00,-2.0526200670409165E+00, 1.6491636277910218E+00,', & ' -1.1706850778234652E+00,-2.0526200670409165E+00,-1.6491636277910218E+00,', & ' 1.1706850778234652E+00, 2.0526200670409165E+00,-1.6491636277910218E+00,', & ' 1.1706850778234652E+00, 2.0526200670409165E+00, 1.6491636277910218E+00', & ' ],', & ' "molecular_charge": 0,', & ' "connectivity": [', & ' [ 0, 1, 1], [ 1, 2, 1], [ 2, 3, 1], [ 3, 4, 1], [ 4, 5, 1],', & ' [ 5, 6, 1], [ 5, 7, 1], [ 5, 8, 1], [ 4, 9, 1], [ 4,10, 1],', & ' [ 3,11, 1], [ 3,12, 1], [ 2,13, 1], [ 2,14, 1], [ 1,15, 1],', & ' [ 1,16, 1], [ 0,17, 1], [17,18, 1], [18,19, 1], [19,20, 1],', & ' [20,21, 1], [21,22, 1], [22,23, 1], [22,24, 1], [22,25, 1],', & ' [21,26, 1], [21,27, 1], [20,28, 1], [20,29, 1], [19,30, 1],', & ' [19,31, 1], [18,32, 1], [18,33, 1], [17,34, 1], [17,35, 1],', & ' [ 0,36, 1], [ 0,37, 1]', & ' ]', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 38, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_qcschema subroutine test_valid4_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3", & "WATER27, H2O", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 ", & "3", & "WATER27, H2O", & "O -1.1469443 0.0697649 1.1470196 ", & "H -1.2798308 -0.5232169 1.8902833 ", & "H -1.0641398 -0.4956693 0.3569250 ", & "3", & "WATER27, H2O", & "O -0.1633508 -1.0289346 -1.2401808 ", & "H 0.4914771 -0.3248733 -1.0784838 ", & "H -0.5400907 -0.8496512 -2.1052499 " rewind(unit) call read_qcschema(struc, unit, error) if (.not.allocated(error)) then call read_qcschema(struc, unit, error) end if close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_qcschema subroutine test_valid5_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3", & "WATER27, H2O", & "8 1.1847029 1.1150792 -0.0344641 ", & "1 0.4939088 0.9563767 0.6340089 ", & "1 2.0242676 1.0811246 0.4301417 ", & "3", & "WATER27, H2O", & "8 -1.1469443 0.0697649 1.1470196 ", & "1 -1.2798308 -0.5232169 1.8902833 ", & "1 -1.0641398 -0.4956693 0.3569250 " rewind(unit) call read_qcschema(struc, unit, error) if (.not.allocated(error)) then call read_qcschema(struc, unit, error) end if close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid5_qcschema subroutine test_invalid1_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 2,', & ' "schema_name": "qcschema_molecule",', & ' "molecule": {', & ' "geometry": [', & ' 0.0, 0.0000, -0.1294,', & ' 0.0, -1.4941, 1.0274,', & ' 0.0, 1.4941, 1.0274', & ' ],', & ' "symbols": ["O", "H", "H"],', & ' "comment": "Water molecule"', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid1_qcschema subroutine test_invalid2_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 0,', & ' "schema_name": "qcschema_molecule",', & ' "molecule": {', & ' "geometry": [', & ' 0.0, 0.0000, -0.1294,', & ' 0.0, -1.4941, 1.0274,', & ' 0.0, 1.4941, 1.0274', & ' ],', & ' "symbols": ["O", "H", "H"],', & ' "comment": "Water molecule"', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid2_qcschema subroutine test_invalid3_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 1,', & ' "schema_name": "qcschema_molecule",', & ' "molecule": {', & ' "geometry": [', & ' 0.0, 0.0000, -0.1294,', & ' 0.0, -1.4941, 1.0274,', & ' 0.0, 1.4941, 1.0274', & ' ],', & ' "symbols": ["O", "H", "H", "H"],', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid3_qcschema subroutine test_invalid4_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 1,', & ' "schema_name": "qcschema_molecule",', & ' "molecule": {', & ' "geometry": [', & ' 0.0, 0.0000, -0.1294,', & ' 0.0, -1.4941, 1.0274,', & ' 0.0, 1.4941, 1.0274', & ' ],', & ' "atomic_numbers": [8, 1, 1],', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid4_qcschema subroutine test_invalid5_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "schema_version": 1,', & ' "schema_name": "qcschema_molecule",', & ' "molecule": {', & ' "geometry": [', & ' 0.0, 0.0000, -0.1294,', & ' 0.0, -1.4941, 1.0274,' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid5_qcschema subroutine test_invalid6_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & '{', & ' "chemical json": 0,', & ' "name": "ethane",', & ' "inchi": "1/C2H6/c1-2/h1-2H3",', & ' "formula": "C 2 H 6",', & ' "atoms": {', & ' "elements": {', & ' "number": [ 1, 6, 1, 1, 6, 1, 1, 1 ]', & ' },', & ' "coords": {', & ' "3d": [ 1.185080, -0.003838, 0.987524,', & ' 0.751621, -0.022441, -0.020839,', & ' 1.166929, 0.833015, -0.569312,', & ' 1.115519, -0.932892, -0.514525,', & ' -0.751587, 0.022496, 0.020891,', & ' -1.166882, -0.833372, 0.568699,', & ' -1.115691, 0.932608, 0.515082,', & ' -1.184988, 0.004424, -0.987522 ]', & ' }', & ' },', & ' "bonds": {', & ' "connections": {', & ' "index": [ 0, 1,', & ' 1, 2,', & ' 1, 3,', & ' 1, 4,', & ' 4, 5,', & ' 4, 6,', & ' 4, 7 ]', & ' },', & ' "order": [ 1, 1, 1, 1, 1, 1, 1 ]', & ' }', & '}' rewind(unit) call read_qcschema(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid6_qcschema end module test_read_qcschema mctc-lib-0.3.2/test/test_read_turbomole.f90000066400000000000000000001156751466406626700206070ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_turbomole use mctc_env, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_turbomole use mctc_io_structure implicit none private public :: collect_read_turbomole contains !> Collect all exported unit tests subroutine collect_read_turbomole(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-coord", test_valid1_coord), & & new_unittest("valid2-coord", test_valid2_coord), & & new_unittest("valid3-coord", test_valid3_coord), & & new_unittest("valid4-coord", test_valid4_coord), & & new_unittest("valid5-coord", test_valid5_coord), & & new_unittest("valid6-coord", test_valid6_coord), & & new_unittest("valid7-coord", test_valid7_coord), & & new_unittest("valid8-coord", test_valid8_coord), & & new_unittest("valid9-coord", test_valid9_coord), & & new_unittest("valid10-coord", test_valid10_coord), & & new_unittest("valid11-coord", test_valid11_coord), & & new_unittest("invalid1-coord", test_invalid1_coord, should_fail=.true.), & & new_unittest("invalid2-coord", test_invalid2_coord, should_fail=.true.), & & new_unittest("invalid3-coord", test_invalid3_coord, should_fail=.true.), & & new_unittest("invalid4-coord", test_invalid4_coord, should_fail=.true.), & & new_unittest("invalid5-coord", test_invalid5_coord, should_fail=.true.), & & new_unittest("invalid6-coord", test_invalid6_coord, should_fail=.true.), & & new_unittest("invalid7-coord", test_invalid7_coord, should_fail=.true.), & & new_unittest("invalid8-coord", test_invalid8_coord, should_fail=.true.), & & new_unittest("invalid9-coord", test_invalid9_coord, should_fail=.true.), & & new_unittest("invalid10-coord", test_invalid10_coord, should_fail=.true.), & & new_unittest("invalid11-coord", test_invalid11_coord, should_fail=.true.), & & new_unittest("invalid12-coord", test_invalid12_coord, should_fail=.true.), & & new_unittest("invalid13-coord", test_invalid13_coord, should_fail=.true.), & & new_unittest("invalid14-coord", test_invalid14_coord, should_fail=.true.), & & new_unittest("invalid15-coord", test_invalid15_coord, should_fail=.true.), & & new_unittest("invalid16-coord", test_invalid16_coord, should_fail=.true.) & & ] end subroutine collect_read_turbomole subroutine test_valid1_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord angs", & " 1.1847029 1.1150792 -0.0344641 O", & " 0.4939088 0.9563767 0.6340089 H", & " 2.0242676 1.0811246 0.4301417 H", & "-1.1469443 0.0697649 1.1470196 O", & "-1.2798308 -0.5232169 1.8902833 H", & "-1.0641398 -0.4956693 0.3569250 H", & "-0.1633508 -1.0289346 -1.2401808 O", & " 0.4914771 -0.3248733 -1.0784838 H", & "-0.5400907 -0.8496512 -2.1052499 H", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 9, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_coord subroutine test_valid2_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 1.36794785746435 13.45808943446053 8.83754983226359 c", & " 3.69183290816438 13.13552229161569 10.16652201690950 c", & " 1.36792668081267 10.38660504434782 13.04411926632965 c", & " 3.69180534781206 11.55414582295511 12.33193380846742 c", & " 1.36791549262702 3.53066844289674 10.38660588677206 c", & " 1.36792046664920 7.73723910626293 13.45809224934817 c", & " 3.69181279359489 6.40826717723392 13.13552570942280 c", & " 1.36792009865062 3.11669712338516 7.73723850632628 c", & " 3.69181515738094 3.43926499914873 6.40826580885474 c", & " 3.69178443989294 4.24285720771059 11.55415026712869 c", & " 1.36790824853106 6.18818490375705 3.53066863732142 c", & " 3.69178194163078 5.02063901427657 4.24285736953327 c", & " 1.36794124909207 13.04411858182861 6.18818324080182 c", & " 1.36792249732236 8.83755133592807 3.11669686076913 c", & " 3.69182456413952 10.16652118921143 3.43926084011816 c", & " 3.69181444966104 12.33193631088573 5.02063847821044 c", & " 6.01572566324028 13.45790756713123 8.83752222635545 c", & " 8.33965926123256 13.13576644753615 10.16660228658307 c", & " 6.01574747573805 10.38654070512969 13.04391961251944 c", & " 8.33964066450677 11.55427002850905 12.33211653730939 c", & " 6.01574728097580 3.53087013230607 10.38654217813321 c", & " 6.01568913853645 7.73726406411719 13.45790864082374 c", & " 8.33963586549168 6.40818371470975 13.13576911116618 c", & " 6.01568179676984 3.11688332536281 7.73726611148835 c", & " 8.33963704688671 3.43902559351770 6.40818390180453 c", & " 8.33962496288127 4.24267007149867 11.55427031066552 c", & " 6.01573464280675 6.18824653544318 3.53086861480278 c", & " 8.33961857277245 5.02052001792996 4.24267413625204 c", & " 6.01575677304189 13.04392044501564 6.18824448603611 c", & " 6.01568344836224 8.83752193432504 3.11688171781516 c", & " 8.33964228963694 10.16660428027860 3.43902155668011 c", & " 8.33965118613331 12.33211762632282 5.02051902430387 c", & "$periodic 1", & "$eht charge=0 unpaired=0", & "$cell", & " 9.29556285275863798006", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 32, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_coord subroutine test_valid3_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " -0.12918412100093 0.06210659750976 -2.13384498734326 c", & " 0.12856915667443 -0.07403227791901 4.02358027265954 c", & " -0.12317720857511 2.75170732207802 -2.13345350602279 c", & " 2.44816466162280 1.28612566399214 4.02317048854901 c", & "$eht unpaired=0 charge=0", & "$periodic 2", & "$cell angs", & " 2.4809835980 2.4811430162 120.2612191150", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 4, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_coord subroutine test_valid4_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$cell", & " 4.766080896955 4.766080896955 4.766080896955 60. 60. 60.", & "$coord", & " 0.00000000000000 0.00000000000000 0.00000000000000 c", & " 2.38304045219106 1.39084904447079 0.97287218605834 c", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 2, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_coord subroutine test_valid5_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord frac", & " 0.25000000000000 0.25000000000000 0.25000000000000 f", & " 0.75000000000000 0.75000000000000 0.75000000000000 f", & " 0.00000000000000 0.00000000000000 0.00000000000000 ca", & "$user-defined bonds", & "$lattice angs", & " 3.153833580475253 1.115048555743951 1.931320751454818", & " 0.000000000000000 3.345145667231851 1.931320751454818", & " 0.000000000000000 0.000000000000000 3.862641502909638", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid5_coord subroutine test_valid6_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$cell", & " 9.09903133 9.09903130512 30.4604956 90.0 90.0 120.000000127", & "$coord", & " -0.57949455800000 0.06835893310000 -7.51993484000000 ca", & " -0.57949455800000 0.06835893310000 7.71031294000000 mg", & " -0.57949455800000 0.06835893310000 -0.10280417200000 c", & " 1.73848367000000 -0.20507679900000 -0.08757392470000 o", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 4, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return end subroutine test_valid6_coord subroutine test_valid7_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 2.82781861325240 2.96439280874170 3.12827803849279 o", & " 7.19124230791576 0.98723342603994 4.89004701836746 o", & " 4.95491880597601 4.82830910314898 8.74847811174740 o", & " 0.19290883043307 2.30645007856310 8.72969832061507 o", & " -2.01592208020090 6.16478744235115 4.87273962147340 o", & " 0.66183062221384 7.07392578563696 0.27767968372345 o", & " 4.55701736204879 0.06291337111965 3.31745840478609 si", & " -2.10064209975148 3.63969476409878 6.81014625000326 si", & " 2.31009832827224 4.12572862149043 0.08842485276656 si", & "$user-defined bonds", & "$cell", & " 9.28422449595511046 9.28422449595511046 10.21434769907115 90.0000 90.0000 120.0000", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 9, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid7_coord subroutine test_valid8_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " -1.79537625851198 -3.77866422935275 -1.07883558363403 h", & " -2.68278833302782 0.38892666265890 1.66214865238427 s", & " 0.11484649791305 1.48857933226955 3.65660396510375 b", & " -1.07998879593946 -0.16259121615748 -4.55703065871422 o", & " 0.60302832999383 4.08816149622342 -0.02589373148029 mg", & " -1.22534089315880 -1.79981382478068 -3.70773173318592 h", & " -1.33460982049866 -4.24819082475503 2.72791902701083 h", & " -0.16278082578516 2.41267994179303 5.69030695190570 h", & " 2.87802444057103 -0.33120525058830 1.88311373530297 si", & " 0.68489327931487 0.32790204044961 -4.20547693710673 h", & " -1.20919773588330 -2.87253762561437 0.94064204223101 b", & " -3.25572604597922 2.21241092990940 -2.86715549314771 li", & " -1.83147468262373 5.20527293771933 -2.26976270603341 f", & " 4.90885865772880 -1.92576561961811 2.99069919443735 h", & " 1.26806242248758 -2.60409341782411 0.55162805282247 h", & " 4.11956976339902 1.59892866766766 -1.39117477789609 s", & "$eht unpaired=1", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 16, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 8, "Number of species does not match") if (allocated(error)) return call check(error, struc%uhf, 1, "Number of unpaired electrons does not match") if (allocated(error)) return end subroutine test_valid8_coord subroutine test_valid9_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 4.82824919102333E-02 5.71831000079710E-02 1.73514614763116E-01 C", & " 4.82824919102333E-02 5.71831000079710E-02 2.78568246476372E+00 N", & " 2.46093310136750E+00 5.71831000079710E-02 3.59954953387915E+00 C", & " 3.99138416000780E+00 -2.21116805417472E-01 1.58364683739854E+00 N", & " 2.54075511539052E+00 -1.18599185608072E-01 -5.86344093538442E-01 C", & " -2.06104824371096E+00 8.28021114689117E-01 4.40357113204146E+00 C", & " 6.72173545596011E+00 2.10496546922931E-01 1.72565972456309E+00 C", & " 3.05878562448454E+00 7.09403031823937E-02 5.55721088395376E+00 H", & " 3.36822820962351E+00 -2.07680855613880E-01 -2.46191575873710E+00 H", & " -1.68465267663933E+00 1.48551338123814E-01 -9.21486948343917E-01 H", & " -3.83682349412373E+00 3.78984491295393E-01 3.43261116458953E+00 H", & " -1.96215889726624E+00 -2.17412943024358E-01 6.19219651728748E+00 H", & " -1.85966017471395E+00 2.87036107386343E+00 4.74746341688781E+00 H", & " 7.49947096948557E+00 -8.77758695396645E-01 3.31081834253025E+00 H", & " 7.58490546886959E+00 -4.29156708916399E-01 -4.73754235690626E-02 H", & " 7.00829346274163E+00 2.24769645216395E+00 2.03795579552532E+00 H", & "$eht charge=1", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 16, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 3, "Number of species does not match") if (allocated(error)) return call check(error, struc%charge, 1.0_wp, "Total charge does not match") if (allocated(error)) return end subroutine test_valid9_coord subroutine test_valid10_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$cell", & " 8.00000006 ", & "$periodic 1", & "$coord", & " -2.00000001000000 3.50586945000000 0.00000000000000 b", & " -2.00000001000000 2.98408124000000 2.61870552000000 n", & " -2.00000001000000 1.49889804000000 -1.76123460000000 n", & " -2.00000001000000 5.56753332000000 -0.69908457400000 h", & " -2.00000001000000 0.45532164600000 3.47617645000000 b", & " -2.00000001000000 -1.02986157000000 -0.90376369200000 b", & " -2.00000001000000 -1.55164977000000 1.71494186000000 n", & " -2.00000001000000 0.02991464770000 5.61117202000000 h", & " -2.00000001000000 -2.66611845000000 -2.33967477000000 h", & " -2.00000001000000 4.53085539000000 3.97609015000000 h", & " -2.00000001000000 -3.50056641000000 2.37579525000000 h", & " -2.00000001000000 1.90104056000000 -3.77947261000000 h", & " 2.00000001000000 1.55164977000000 -1.71494183000000 b", & " 2.00000001000000 1.02986156000000 0.90376368700000 n", & " 2.00000001000000 -0.45532163900000 -3.47617644000000 n", & " 2.00000001000000 3.61331364000000 -2.41402641000000 h", & " 2.00000001000000 -1.49889804000000 1.76123461000000 b", & " 2.00000001000000 -2.98408125000000 -2.61870553000000 b", & " 2.00000001000000 -3.50586946000000 0.00000002473480 n", & " 2.00000001000000 -1.92430504000000 3.89623019000000 h", & " 2.00000001000000 -4.62033813000000 -4.05461660000000 h", & " 2.00000001000000 2.57663570000000 2.26114832000000 h", & " 2.00000001000000 -5.45478609000000 0.66085341700000 h", & " 2.00000001000000 -0.05317912580000 -5.49441445000000 h", & "$user-defined bonds", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 3, "Number of species does not match") if (allocated(error)) return call check(error, count(struc%periodic), 1, "Periodic of system does not match") if (allocated(error)) return end subroutine test_valid10_coord subroutine test_valid11_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord frac", & " 0.00000000000000 0.00000000000000 0.00000000000000 mg", & " 0.50000000000000 0.00000000000000 0.00000000000000 o", & " 0.00000000000000 0.50000000000000 0.00000000000000 o", & " 0.00000000000000 0.00000000000000 3.97881835572287 o", & " 0.50000000000000 0.50000000000000 0.00000000000000 mg", & " 0.50000000000000 0.00000000000000 3.97881835572287 mg", & " 0.00000000000000 0.50000000000000 3.97881835572287 mg", & " 0.50000000000000 0.50000000000000 3.97881835572287 o", & "$periodic 2", & "$lattice", & " 5.626898880882 -5.626898880882", & " 5.626898880882 5.626898880882", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 8, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return call check(error, count(struc%periodic), 2, "Periodic of system does not match") if (allocated(error)) return end subroutine test_valid11_coord subroutine test_invalid1_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid1_coord subroutine test_invalid2_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 2.82781861325240 2.96439280874170 3.12827803849279 o", & " 7.19124230791576 0.98723342603994 4.89004701836746 o", & " 4.95491880597601 4.82830910314898 8.74847811174740 o", & " 0.19290883043307 2.30645007856310 8.72969832061507 o", & " -2.01592208020090 6.16478744235115 4.87273962147340 o", & " 0.66183062221384 7.07392578563696 0.27767968372345 o", & " 4.55701736204879 0.06291337111965 3.31745840478609 si", & " -2.10064209975148 3.63969476409878 6.81014625000326 si", & " 2.31009832827224 4.12572862149043 0.08842485276656 si", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid2_coord subroutine test_invalid3_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 2.82781861325240 2.96439280874170 3.12827803849279 o", & " 7.19124230791576 0.98723342603994 4.89004701836746 o", & " 4.95491880597601 4.82830910314898 8.74847811174740 o", & " 0.19290883043307 2.30645007856310 8.72969832061507 o", & " -2.01592208020090 6.16478744235115 4.87273962147340 o", & " 0.66183062221384 7.07392578563696 0.27767968372345 o", & " 4.55701736204879 0.06291337111965 3.31745840478609 si", & " -2.10064209975148 3.63969476409878 6.81014625000326 si", & " 2.31009832827224 4.12572862149043 0.08842485276656 si", & "$user-defined bonds", & "$cell", & " 9.28422449595511046 9.28422449595511046 10.21434769907115 90.0000 90.0000 120.0000", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid3_coord subroutine test_invalid4_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord angs", & "-1.1469443 0.0697649 1.1470196 --->o", & "-1.2798308 -0.5232169 1.8902833 H", & "-1.0641398 -0.4956693 0.3569250 H", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid4_coord subroutine test_invalid5_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord frac", & " 0.25000000000000 0.25000000000000 0.25000000000000 f", & " 0.75000000000000 0.75000000000000 0.75000000000000 f", & " 0.00000000000000 0.00000000000000 0.00000000000000 ca", & "$user-defined bonds", & "$lattice angs", & " 3.153833580475253 1.115048555743951 1.931320751454818", & " 0.000000000000000 3.345145667231851 1.931320751454818", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid5_coord subroutine test_invalid6_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord frac", & " 0.25000000000000 0.25000000000000 0.25000000000000 f", & " 0.75000000000000 0.75000000000000 0.75000000000000 f", & " 0.00000000000000 0.00000000000000 0.00000000000000 ca", & "$periodic 0", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid6_coord subroutine test_invalid7_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 1.36794785746435 13.45808943446053 8.83754983226359 c", & " 3.69183290816438 13.13552229161569 10.16652201690950 c", & " 1.36792668081267 10.38660504434782 13.04411926632965 c", & " 3.69180534781206 11.55414582295511 12.33193380846742 c", & " 1.36791549262702 3.53066844289674 10.38660588677206 c", & " 1.36792046664920 7.73723910626293 13.45809224934817 c", & " 3.69181279359489 6.40826717723392 13.13552570942280 c", & " 1.36792009865062 3.11669712338516 7.73723850632628 c", & " 3.69181515738094 3.43926499914873 6.40826580885474 c", & " 3.69178443989294 4.24285720771059 11.55415026712869 c", & " 1.36790824853106 6.18818490375705 3.53066863732142 c", & " 3.69178194163078 5.02063901427657 4.24285736953327 c", & " 1.36794124909207 13.04411858182861 6.18818324080182 c", & " 1.36792249732236 8.83755133592807 3.11669686076913 c", & " 3.69182456413952 10.16652118921143 3.43926084011816 c", & " 3.69181444966104 12.33193631088573 5.02063847821044 c", & " 6.01572566324028 13.45790756713123 8.83752222635545 c", & " 8.33965926123256 13.13576644753615 10.16660228658307 c", & " 6.01574747573805 10.38654070512969 13.04391961251944 c", & " 8.33964066450677 11.55427002850905 12.33211653730939 c", & " 6.01574728097580 3.53087013230607 10.38654217813321 c", & " 6.01568913853645 7.73726406411719 13.45790864082374 c", & " 8.33963586549168 6.40818371470975 13.13576911116618 c", & " 6.01568179676984 3.11688332536281 7.73726611148835 c", & " 8.33963704688671 3.43902559351770 6.40818390180453 c", & " 8.33962496288127 4.24267007149867 11.55427031066552 c", & " 6.01573464280675 6.18824653544318 3.53086861480278 c", & " 8.33961857277245 5.02052001792996 4.24267413625204 c", & " 6.01575677304189 13.04392044501564 6.18824448603611 c", & " 6.01568344836224 8.83752193432504 3.11688171781516 c", & " 8.33964228963694 10.16660428027860 3.43902155668011 c", & " 8.33965118613331 12.33211762632282 5.02051902430387 c", & "$periodic 1", & "$lattice", & " 9.29556285275863798006", & "$cell", & " 9.29556285275863798006", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid7_coord subroutine test_invalid8_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord angs", & " 1.1847029 1.1150792 -0.0344641 O", & " 0.4939088 0.9563767 0.6340089 H", & " 2.0242676 1.0811246 0.4301417 H", & "-1.1469443 abcd.efgh 1.1470196 O", & "-1.2798308 -0.5232169 1.8902833 H", & "-1.0641398 -0.4956693 0.3569250 H", & "-0.1633508 -1.0289346 -1.2401808 O", & " 0.4914771 -0.3248733 -1.0784838 H", & "-0.5400907 -0.8496512 -2.1052499 H", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid8_coord subroutine test_invalid9_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$cell", & " 4.766080896955 4.766080896955 4.766080896955 60. 60. 60.", & "$coord", & " 0.00000000000000 0.00000000000000 0.00000000000000 c", & " 2.38304045219106 1.39084904447079 0.97287218605834 c", & "$periodic 4", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid9_coord subroutine test_invalid10_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 4.82824919102333E-02 5.71831000079710E-02 1.73514614763116E-01 C", & " 4.82824919102333E-02 5.71831000079710E-02 2.78568246476372E+00 N", & " 2.46093310136750E+00 5.71831000079710E-02 3.59954953387915E+00 C", & " 3.99138416000780E+00 -2.21116805417472E-01 1.58364683739854E+00 N", & " 2.54075511539052E+00 -1.18599185608072E-01 -5.86344093538442E-01 C", & " -2.06104824371096E+00 8.28021114689117E-01 4.40357113204146E+00 C", & " 6.72173545596011E+00 2.10496546922931E-01 1.72565972456309E+00 C", & " 3.05878562448454E+00 7.09403031823937E-02 5.55721088395376E+00 H", & " 3.36822820962351E+00 -2.07680855613880E-01 -2.46191575873710E+00 H", & " -1.68465267663933E+00 1.48551338123814E-01 -9.21486948343917E-01 H", & " -3.83682349412373E+00 3.78984491295393E-01 3.43261116458953E+00 H", & " -1.96215889726624E+00 -2.17412943024358E-01 6.19219651728748E+00 H", & " -1.85966017471395E+00 2.87036107386343E+00 4.74746341688781E+00 H", & " 7.49947096948557E+00 -8.77758695396645E-01 3.31081834253025E+00 H", & " 7.58490546886959E+00 -4.29156708916399E-01 -4.73754235690626E-02 H", & " 7.00829346274163E+00 2.24769645216395E+00 2.03795579552532E+00 H", & "$eht charge=one unpaired=0", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid10_coord subroutine test_invalid11_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " 4.82824919102333E-02 5.71831000079710E-02 1.73514614763116E-01 C", & " 4.82824919102333E-02 5.71831000079710E-02 2.78568246476372E+00 N", & " 2.46093310136750E+00 5.71831000079710E-02 3.59954953387915E+00 C", & " 3.99138416000780E+00 -2.21116805417472E-01 1.58364683739854E+00 N", & " 2.54075511539052E+00 -1.18599185608072E-01 -5.86344093538442E-01 C", & " -2.06104824371096E+00 8.28021114689117E-01 4.40357113204146E+00 C", & " 6.72173545596011E+00 2.10496546922931E-01 1.72565972456309E+00 C", & " 3.05878562448454E+00 7.09403031823937E-02 5.55721088395376E+00 H", & " 3.36822820962351E+00 -2.07680855613880E-01 -2.46191575873710E+00 H", & " -1.68465267663933E+00 1.48551338123814E-01 -9.21486948343917E-01 H", & " -3.83682349412373E+00 3.78984491295393E-01 3.43261116458953E+00 H", & " -1.96215889726624E+00 -2.17412943024358E-01 6.19219651728748E+00 H", & " -1.85966017471395E+00 2.87036107386343E+00 4.74746341688781E+00 H", & " 7.49947096948557E+00 -8.77758695396645E-01 3.31081834253025E+00 H", & " 7.58490546886959E+00 -4.29156708916399E-01 -4.73754235690626E-02 H", & " 7.00829346274163E+00 2.24769645216395E+00 2.03795579552532E+00 H", & "$eht unpaired=", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid11_coord subroutine test_invalid12_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " -0.12918412100093 0.06210659750976 -2.13384498734326 c", & " 0.12856915667443 -0.07403227791901 4.02358027265954 c", & "$eht unpaired=0 charge=0", & "$periodic 2", & "$cell angs", & " 2.4809835980 2.4811430162 120.2612191150", & "$coord", & " -0.12317720857511 2.75170732207802 -2.13345350602279 c", & " 2.44816466162280 1.28612566399214 4.02317048854901 c", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid12_coord subroutine test_invalid13_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " -0.12918412100093 0.06210659750976 -2.13384498734326 c", & " 0.12856915667443 -0.07403227791901 4.02358027265954 c", & " -0.12317720857511 2.75170732207802 -2.13345350602279 c", & " 2.44816466162280 1.28612566399214 4.02317048854901 c", & "$cell angs", & " 2.4809835980 2.4811430162 120.2612191150", & "$eht unpaired=0 charge=0", & "$periodic 2", & "$cell angs", & " 2.4809835980 2.4811430162 120.2612191150", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid13_coord subroutine test_invalid14_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$coord", & " -0.12918412100093 0.06210659750976 -2.13384498734326 c", & " 0.12856915667443 -0.07403227791901 4.02358027265954 c", & " -0.12317720857511 2.75170732207802 -2.13345350602279 c", & " 2.44816466162280 1.28612566399214 4.02317048854901 c", & "$eht unpaired=0 charge=0", & "$periodic 2", & "$cell angs", & " 2.4809835980 2.4811430162 120.2612191150", & "$periodic 2", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid14_coord subroutine test_invalid15_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$eht charge=0", & "$coord", & " -0.12918412100093 0.06210659750976 -2.13384498734326 c", & " 0.12856915667443 -0.07403227791901 4.02358027265954 c", & " -0.12317720857511 2.75170732207802 -2.13345350602279 c", & " 2.44816466162280 1.28612566399214 4.02317048854901 c", & "$eht unpaired=0", & "$periodic 2", & "$cell angs", & " 2.4809835980 2.4811430162 120.2612191150", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid15_coord subroutine test_invalid16_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "$lattice angs", & " 3.153833580475253 1.115048555743951 1.931320751454818", & " 0.000000000000000 3.345145667231851 1.931320751454818", & " 0.000000000000000 0.000000000000000 3.862641502909638", & "$coord frac", & " 0.25000000000000 0.25000000000000 0.25000000000000 f", & " 0.75000000000000 0.75000000000000 0.75000000000000 f", & " 0.00000000000000 0.00000000000000 0.00000000000000 ca", & "$user-defined bonds", & "$lattice angs", & " 3.153833580475253 1.115048555743951 1.931320751454818", & " 0.000000000000000 3.345145667231851 1.931320751454818", & " 0.000000000000000 0.000000000000000 3.862641502909638", & "$periodic 3", & "$end" rewind(unit) call read_coord(struc, unit, error) close(unit) end subroutine test_invalid16_coord end module test_read_turbomole mctc-lib-0.3.2/test/test_read_vasp.f90000066400000000000000000000402701466406626700175340ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_vasp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check, & & test_failed use mctc_io_read_vasp use mctc_io_structure implicit none private public :: collect_read_vasp contains !> Collect all exported unit tests subroutine collect_read_vasp(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-poscar", test_valid1_poscar), & & new_unittest("valid2-poscar", test_valid2_poscar), & & new_unittest("valid3-poscar", test_valid3_poscar), & & new_unittest("valid4-poscar", test_valid4_poscar), & & new_unittest("valid5-poscar", test_valid5_poscar), & & new_unittest("invalid1-poscar", test_invalid1_poscar, should_fail=.true.), & & new_unittest("invalid2-poscar", test_invalid2_poscar, should_fail=.true.), & & new_unittest("invalid3-poscar", test_invalid3_poscar, should_fail=.true.), & & new_unittest("invalid4-poscar", test_invalid4_poscar, should_fail=.true.), & & new_unittest("invalid5-poscar", test_invalid5_poscar, should_fail=.true.), & & new_unittest("invalid6-poscar", test_invalid6_poscar, should_fail=.true.), & & new_unittest("invalid7-poscar", test_invalid7_poscar, should_fail=.true.), & & new_unittest("issue60", test_issue60) & & ] end subroutine collect_read_vasp subroutine test_valid1_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Ti O ", & " 1.0000000000000000", & " 4.59373 0.00000 0.00000", & " 0.00000 4.59373 0.00000", & " 0.00000 0.00000 2.95812", & " 2 4", & "Cartesian", & " 0.000000000 0.000000000 0.000000000", & " 2.296865000 2.296865000 1.479060000", & " 1.402465769 1.402465769 0.000000000", & " 3.191264231 3.191264231 0.000000000", & " 3.699330769 0.894399231 1.479060000", & " 0.894399231 3.699330769 1.479060000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Pre-Vasp5 comment line is used to store symbols") if (allocated(error)) return call check(error, struc%nat, 6, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_poscar subroutine test_valid2_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Anatase", & " 1.0000000000000000", & " 3.7850000000000000 0.0000000000000000 0.0000000000000000", & " 0.0000000000000000 3.7850000000000000 0.0000000000000000", & " 0.0000000000000000 0.0000000000000000 9.5140000000000000", & " Ti O ", & " 4 8", & "Selective", & "Cartesian", & " 0.0000000000000000 0.0000000000000000 0.0000000000000000", & " 1.8925000000000000 1.8925000000000000 4.7570000000000000", & " 0.0000000000000000 1.8925000000000000 2.3785000000000000", & " 1.8925000000000000 0.0000000000000000 7.1355000000000000", & " 0.0000000000000000 0.0000000000000000 1.9655924000000000", & " 1.8925000000000000 1.8925000000000000 6.7225924000000000", & " 0.0000000000000000 1.8925000000000000 4.3440924000000000", & " 1.8925000000000000 0.0000000000000000 9.1010924000000000", & " 1.8925000000000000 1.8925000000000000 2.7914076000000000", & " 0.0000000000000000 0.0000000000000000 7.5484076000000000", & " 1.8925000000000000 0.0000000000000000 5.1699076000000000", & " 0.0000000000000000 1.8925000000000000 0.4129076000000000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "Anatase") if (allocated(error)) return call check(error, struc%nat, 12, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_poscar subroutine test_valid3_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "cubic diamond", & " 3.7", & " 0.5 0.5 0.0", & " 0.0 0.5 0.5", & " 0.5 0.0 0.5", & " C", & " 2", & "Direct", & " 0.0 0.0 0.0", & " 0.25 0.25 0.25" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%comment, "cubic diamond") if (allocated(error)) return call check(error, struc%nat, 2, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_poscar subroutine test_valid4_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "C2 F2", & "1.0", & " 1.291 2.23608 +0.0000000000", & " -1.291 2.23608 +0.0000000000", & " +0.0000000000 +0.0000000000 5.75", & " 2 2", & "cartesian", & " 0.00000000 0.00000000 1.37627335", & " 0.00000000 2.98144198 1.86702665", & " 0.00000000 0.00000000 0.00394701", & " 0.00000000 2.98144198 3.23935299" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 4, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_poscar subroutine test_valid5_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & " O C H ", & " 1.0000000000000000", & " 6.4411018522600001 0.0492571261505000 0.2192046129910000", & " 0.0462076831739000 6.6435057067500001 0.1670513770770000", & " 0.2262248220170000 -0.9573234940220000 6.7608039126200001", & " 4 12 16", & "Cartesian", & " 4.5853168464880421 4.9392326929575878 4.1894081210748118", & " 5.8862267152491423 1.1425258978245871 6.5015058204768126", & " 1.4284279616220412 4.6017511285540875 3.1465884436348119", & " 2.3323404704521411 1.4471801154820869 0.7121932185858125", & " 4.7333543155561415 2.7747291872305868 3.1951352976178122", & " 5.6617754419101418 2.2133191164485870 2.1235404838618126", & " 5.3107598618381422 2.6902988056185868 0.7384466319968125", & " 4.4947071071761426 3.9530790692635867 0.6801776747598124", & " 4.8005171923760424 4.9185102874975870 1.8186363449528122", & " 4.6951362687070421 4.2781752812835867 3.1816411821728123", & " 1.3838574419160412 5.2817805008910863 4.1482702947948136", & " 1.0268974195990415 4.7234752637800881 5.4989995400388123", & " 2.0852659694760409 5.0956317453800875 6.5351699846458127", & " 2.3344644666691412 -0.0736561690909131 6.4245628001158135", & " 2.4894017448231409 0.6213510313930869 5.0967297417158131", & " 1.5745272273791413 0.1243470825760870 3.9731040773988129", & " 5.8221065925130420 5.3013563342055878 1.7264876737078123", & " 3.4487807319551416 3.6355832152975864 0.7429568016758125", & " 4.8499393376520423 3.4713855169305874 6.4691872586348129", & " 0.2495364434351412 2.4795455690160870 2.1043557230378123", & " 5.6691068338331423 1.1234174220755870 2.1414388326468128", & " 3.7072009289431418 2.4357632918535872 3.0094700999208119", & " 4.1414520030430415 5.7877262477775879 1.7803680119358125", & " 5.0142851411171421 2.4165926460955873 4.1857610486448129", & " 3.0280930003030413 4.6201081184690871 6.2533190952188136", & " 0.5863628696651412 0.5757236365910867 4.1021714214668128", & " 2.3776130524831411 1.6969724987740866 5.2327688986668139", & " 1.9486148363011413 0.4390675147070869 2.9999022491838123", & " 3.5312997625581413 0.4467415528495868 4.8114121395028135", & " 6.5089895990100421 5.2100409408535882 6.0066553789008132", & " 0.9001165013630412 3.6420787128610868 5.4413106648508132", & " 1.6012116650460413 5.6845471271780879 0.7675566847298124" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 32, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 3, "Number of species does not match") if (allocated(error)) return end subroutine test_valid5_poscar subroutine test_invalid1_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid1_poscar subroutine test_invalid2_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Ti O ", & " 1.0000000000000000", & " 4.59373 0.00000 0.00000", & " 0.00000 4.59373 0.00000", & " 0.00000 0.00000 2.95812", & " 2 4", & "Selective", & " 0.000000000 0.000000000 0.000000000", & " 2.296865000 2.296865000 1.479060000", & " 1.402465769 1.402465769 0.000000000", & " 3.191264231 3.191264231 0.000000000", & " 3.699330769 0.894399231 1.479060000", & " 0.894399231 3.699330769 1.479060000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid2_poscar subroutine test_invalid3_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Ti O ", & " 1.0000000000000000", & " 4.59373 0.00000 0.00000", & " 0.00000 4.59373 0.00000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid3_poscar subroutine test_invalid4_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Ti O ", & " 1.0000000000000000", & " 4.59373 0.00000 0.00000", & " 0.00000 4.59373 0.00000", & " 0.00000 0.00000 2.95812", & " 2 2 2", & "Cartesian", & " 0.000000000 0.000000000 0.000000000", & " 2.296865000 2.296865000 1.479060000", & " 1.402465769 1.402465769 0.000000000", & " 3.191264231 3.191264231 0.000000000", & " 3.699330769 0.894399231 1.479060000", & " 0.894399231 3.699330769 1.479060000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid4_poscar subroutine test_invalid5_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Ti O ", & " 1.0000000000000000", & " ******* 0.00000 0.00000", & " 0.00000 ******* 0.00000", & " 0.00000 0.00000 *******", & " 2 4", & "Cartesian", & " 0.000000000 0.000000000 0.000000000", & " 2.296865000 2.296865000 1.479060000", & " 1.402465769 1.402465769 0.000000000", & " 3.191264231 3.191264231 0.000000000", & " 3.699330769 0.894399231 1.479060000", & " 0.894399231 3.699330769 1.479060000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid5_poscar subroutine test_invalid6_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "Titan Oxygen", & " 1.0000000000000000", & " 4.59373 0.00000 0.00000", & " 0.00000 4.59373 0.00000", & " 0.00000 0.00000 2.95812", & " 2 4", & "Cartesian", & " 0.000000000 0.000000000 0.000000000", & " 2.296865000 2.296865000 1.479060000", & " 1.402465769 1.402465769 0.000000000", & " 3.191264231 3.191264231 0.000000000", & " 3.699330769 0.894399231 1.479060000", & " 0.894399231 3.699330769 1.479060000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid6_poscar subroutine test_invalid7_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "# Rutile", & "Ti O ", & " 1.0000000000000000", & " 4.59373 0.00000 0.00000", & " 0.00000 4.59373 0.00000", & " 0.00000 0.00000 2.95812", & " 2 4", & "Cartesian", & " 0.000000000 0.000000000 0.000000000", & " 2.296865000 2.296865000 1.479060000", & " 1.402465769 1.402465769 0.000000000", & " 3.191264231 3.191264231 0.000000000", & " 3.699330769 0.894399231 1.479060000", & " 0.894399231 3.699330769 1.479060000" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid7_poscar subroutine test_issue60(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "POSCAR", & "3.0", & "1.0 0.0 0.0", & "0.0 1.0 0.0", & "0.0 0.0 1.0", & "S", & "1", & "direct", & "0.0 0.0 0.0" rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 1, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 1, "Number of species does not match") if (allocated(error)) return end subroutine test_issue60 end module test_read_vasp mctc-lib-0.3.2/test/test_read_xyz.f90000066400000000000000000000332731466406626700174220ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_read_xyz use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_read_xyz use mctc_io_structure implicit none private public :: collect_read_xyz contains !> Collect all exported unit tests subroutine collect_read_xyz(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-xyz", test_valid1_xyz), & & new_unittest("valid2-xyz", test_valid2_xyz), & & new_unittest("valid3-xyz", test_valid3_xyz), & & new_unittest("valid4-xyz", test_valid4_xyz), & & new_unittest("valid5-xyz", test_valid5_xyz), & & new_unittest("invalid1-xyz", test_invalid1_xyz, should_fail=.true.), & & new_unittest("invalid2-xyz", test_invalid2_xyz, should_fail=.true.), & & new_unittest("invalid3-xyz", test_invalid3_xyz, should_fail=.true.), & & new_unittest("invalid4-xyz", test_invalid4_xyz, should_fail=.true.), & & new_unittest("invalid5-xyz", test_invalid5_xyz, should_fail=.true.), & & new_unittest("invalid6-xyz", test_invalid6_xyz, should_fail=.true.), & & new_unittest("invalid7-xyz", test_invalid7_xyz, should_fail=.true.) & & ] end subroutine collect_read_xyz subroutine test_valid1_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "9", & "WATER27, (H2O)3", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 ", & "O -1.1469443 0.0697649 1.1470196 ", & "H -1.2798308 -0.5232169 1.8902833 ", & "H -1.0641398 -0.4956693 0.3569250 ", & "O -0.1633508 -1.0289346 -1.2401808 ", & "H 0.4914771 -0.3248733 -1.0784838 ", & "H -0.5400907 -0.8496512 -2.1052499 " rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return call check(error, allocated(struc%comment), "Comment line should be preserved") if (allocated(error)) return call check(error, struc%comment, "WATER27, (H2O)3") if (allocated(error)) return call check(error, struc%nat, 9, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_xyz subroutine test_valid2_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "24", & "", & "C 1.07317 0.04885 -0.07573", & "N 2.51365 0.01256 -0.07580", & "C* 3.35199 1.09592 -0.07533", & "N 4.61898 0.73028 -0.07549", & "C* 4.57907 -0.63144 -0.07531", & "C 3.30131 -1.10256 -0.07524", & "C 2.98068 -2.48687 -0.07377", & "18O 1.82530 -2.90038 -0.07577", & "N 4.11440 -3.30433 -0.06936", & "C* 5.45174 -2.85618 -0.07235", & "O 6.38934 -3.65965 -0.07232", & "N 5.66240 -1.47682 -0.07487", & "C 7.00947 -0.93648 -0.07524", & "C 3.92063 -4.74093 -0.06158", & "D 0.73398 1.08786 -0.07503", & "D 0.71239 -0.45698 0.82335", & "D 0.71240 -0.45580 -0.97549", & "H 2.99301 2.11762 -0.07478", & "H 7.76531 -1.72634 -0.07591", & "H 7.14864 -0.32182 0.81969", & "H 7.14802 -0.32076 -0.96953", & "H 2.86501 -5.02316 -0.05833", & "H 4.40233 -5.15920 0.82837", & "H 4.40017 -5.16929 -0.94780" rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return call check(error, .not.allocated(struc%comment), "Empty comment line should not be saved") if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 7, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_xyz subroutine test_valid3_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "24", & "#", & "c 1.07317 0.04885 -0.07573 -0.05445590", & "n 2.51365 0.01256 -0.07580 -0.00457526", & "c 3.35199 1.09592 -0.07533 0.08391889", & "n 4.61898 0.73028 -0.07549 -0.27870751", & "c 4.57907 -0.63144 -0.07531 0.11914924", & "c 3.30131 -1.10256 -0.07524 -0.02621044", & "c 2.98068 -2.48687 -0.07377 0.26115960", & "o 1.82530 -2.90038 -0.07577 -0.44071824", & "n 4.11440 -3.30433 -0.06936 -0.10804747", & "c 5.45174 -2.85618 -0.07235 0.30411699", & "o 6.38934 -3.65965 -0.07232 -0.44083760", & "n 5.66240 -1.47682 -0.07487 -0.07457706", & "c 7.00947 -0.93648 -0.07524 -0.04790859", & "c 3.92063 -4.74093 -0.06158 -0.03738239", & "h 0.73398 1.08786 -0.07503 0.06457802", & "h 0.71239 -0.45698 0.82335 0.08293905", & "h 0.71240 -0.45580 -0.97549 0.08296802", & "h 2.99301 2.11762 -0.07478 0.05698136", & "h 7.76531 -1.72634 -0.07591 0.09025556", & "h 7.14864 -0.32182 0.81969 0.07152988", & "h 7.14802 -0.32076 -0.96953 0.07159003", & "h 2.86501 -5.02316 -0.05833 0.08590674", & "h 4.40233 -5.15920 0.82837 0.06906357", & "h 4.40017 -5.16929 -0.94780 0.06926350" rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, 24, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 4, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_xyz subroutine test_valid4_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3", & "WATER27, H2O", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 ", & "3", & "WATER27, H2O", & "O -1.1469443 0.0697649 1.1470196 ", & "H -1.2798308 -0.5232169 1.8902833 ", & "H -1.0641398 -0.4956693 0.3569250 ", & "3", & "WATER27, H2O", & "O -0.1633508 -1.0289346 -1.2401808 ", & "H 0.4914771 -0.3248733 -1.0784838 ", & "H -0.5400907 -0.8496512 -2.1052499 " rewind(unit) call read_xyz(struc, unit, error) if (.not.allocated(error)) then call read_xyz(struc, unit, error) end if close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_xyz subroutine test_valid5_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3", & "WATER27, H2O", & "8 1.1847029 1.1150792 -0.0344641 ", & "1 0.4939088 0.9563767 0.6340089 ", & "1 2.0242676 1.0811246 0.4301417 ", & "3", & "WATER27, H2O", & "8 -1.1469443 0.0697649 1.1470196 ", & "1 -1.2798308 -0.5232169 1.8902833 ", & "1 -1.0641398 -0.4956693 0.3569250 " rewind(unit) call read_xyz(struc, unit, error) if (.not.allocated(error)) then call read_xyz(struc, unit, error) end if close(unit) if (allocated(error)) return call check(error, struc%nat, 3, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, 2, "Number of species does not match") if (allocated(error)) return end subroutine test_valid5_xyz subroutine test_invalid1_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "9", & "WATER27, (H2O)3", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 ", & "O -1.1469443 0.0697649 1.1470196 ", & "H -1.2798308 -0.5232169 1.8902833 ", & "H -1.0641398 -0.4956693 0.3569250 " rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid1_xyz subroutine test_invalid2_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "", & "WATER27, (H2O)3", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 ", & "O -1.1469443 0.0697649 1.1470196 ", & "H -1.2798308 -0.5232169 1.8902833 ", & "H -1.0641398 -0.4956693 0.3569250 ", & "O -0.1633508 -1.0289346 -1.2401808 ", & "H 0.4914771 -0.3248733 -1.0784838 ", & "H -0.5400907 -0.8496512 -2.1052499 " rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid2_xyz subroutine test_invalid3_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & & "120" rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid3_xyz subroutine test_invalid4_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "-3", & "H2O", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 " rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid4_xyz subroutine test_invalid5_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3", & "H2O", & "****o 1.1847029 1.1150792 -0.0344641 ", & "****h 0.4939088 0.9563767 0.6340089 ", & "****h 2.0242676 1.0811246 0.4301417 " rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid5_xyz subroutine test_invalid6_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "3", & "H2O", & "1.1847029 1.1150792 -0.0344641 O", & "0.4939088 0.9563767 0.6340089 H", & "2.0242676 1.0811246 0.4301417 H" rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return end subroutine test_invalid6_xyz subroutine test_invalid7_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit open(status='scratch', newunit=unit) write(unit, '(a)') & "nine", & "WATER27, (H2O)3", & "O 1.1847029 1.1150792 -0.0344641 ", & "H 0.4939088 0.9563767 0.6340089 ", & "H 2.0242676 1.0811246 0.4301417 ", & "O -1.1469443 0.0697649 1.1470196 ", & "H -1.2798308 -0.5232169 1.8902833 ", & "H -1.0641398 -0.4956693 0.3569250 ", & "O -0.1633508 -1.0289346 -1.2401808 ", & "H 0.4914771 -0.3248733 -1.0784838 ", & "H -0.5400907 -0.8496512 -2.1052499 " rewind(unit) call read_xyz(struc, unit, error) close(unit) end subroutine test_invalid7_xyz end module test_read_xyz mctc-lib-0.3.2/test/test_symbols.f90000066400000000000000000000110151466406626700172530ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_symbols use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_symbols implicit none private public :: collect_symbols contains !> Collect all exported unit tests subroutine collect_symbols(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid-num-ids", test_num_ids), & & new_unittest("valid-sym-ids", test_sym_ids), & & new_unittest("valid-num", test_valid_num), & & new_unittest("valid-pse", test_valid_pse), & & new_unittest("valid-sym", test_valid_sym) & & ] end subroutine collect_symbols subroutine test_valid_sym(error) !> Error handling type(error_type), allocatable, intent(out) :: error call check(error, to_number("K"), 19, "Wrong atomic number for alium") if (allocated(error)) return call check(error, to_number("ca "), 20, "Could not identify calcium") if (allocated(error)) return call check(error, to_number(" aU "), 79, "Could not identify gold") if (allocated(error)) return call check(error, to_number("CN*"), 112, "Could not identify coperneticum") if (allocated(error)) return call check(error, to_number("*sn"), 50, "Could not identify tin") if (allocated(error)) return call check(error, to_number("d"), 1, "Could not identify deuterium") if (allocated(error)) return end subroutine test_valid_sym subroutine test_valid_num(error) !> Error handling type(error_type), allocatable, intent(out) :: error call check(error, to_symbol(19), "K", "Wrong atomic number for alium") if (allocated(error)) return call check(error, to_symbol(20), "Ca", "Could not identify calcium") if (allocated(error)) return call check(error, to_symbol(79), "Au", "Could not identify gold") if (allocated(error)) return call check(error, to_symbol(112), "Cn", "Could not identify coperneticum") if (allocated(error)) return call check(error, to_symbol(50), "Sn", "Could not identify tin") if (allocated(error)) return call check(error, to_symbol(1), "H", "Could not identify hydrogen") if (allocated(error)) return end subroutine test_valid_num subroutine test_valid_pse(error) !> Error handling type(error_type), allocatable, intent(out) :: error integer :: num character(len=symbol_length) :: sym do num = 1, 118 sym = to_symbol(num) call check(error, to_number(sym), num, "Could not match all elements of the PSE") if (allocated(error)) exit end do end subroutine test_valid_pse subroutine test_sym_ids(error) !> Error handling type(error_type), allocatable, intent(out) :: error integer :: nid integer, allocatable :: ids(:) character(symbol_length), allocatable :: sym(:) sym = [character(symbol_length) :: & & 'Al', 'Ca', 'Ti', 'O ', 'F ', 'Ga', 'Ca', 'Ti', 'S ', 'Cl', 'O ', 'O '] allocate(ids(size(sym))) call get_identity(nid, ids, sym) call check(error, nid, 8, "Expected eight unique element symbols") if (allocated(error)) return call check(error, minval(ids), 1, "Lower bound of IDs is not one") if (allocated(error)) return call check(error, maxval(ids), nid, "Upper bound of IDs is not number of IDs") end subroutine test_sym_ids subroutine test_num_ids(error) !> Error handling type(error_type), allocatable, intent(out) :: error integer :: nid integer, allocatable :: ids(:) integer, allocatable :: num(:) num = [integer :: & & 1, 2, 8, 112, 112, 7, 7, 19, 19, 1, 2, 112, 7, 12, 19, 7, 3, 2, 2] allocate(ids(size(num))) call get_identity(nid, ids, num) call check(error, nid, 8, "Expected eight unique atomic numbers") if (allocated(error)) return call check(error, minval(ids), 1, "Lower bound of IDs is not one") if (allocated(error)) return call check(error, maxval(ids), nid, "Upper bound of IDs is not number of IDs") end subroutine test_num_ids end module test_symbols mctc-lib-0.3.2/test/test_write.f90000066400000000000000000000155571466406626700167340ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write use mctc_env_accuracy, only : wp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use mctc_io_write use mctc_io_read use mctc_io_structure, only : structure_type use mctc_version, only : get_mctc_feature use testsuite_structure, only : get_structure implicit none private public :: collect_write contains !> Collect all exported unit tests subroutine collect_write(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid-cjson", test_cjson, should_fail=.not.get_mctc_feature("json")), & & new_unittest("valid-mol", test_mol), & & new_unittest("valid-sdf", test_sdf), & & new_unittest("valid-gen", test_gen), & & new_unittest("valid-pdb", test_pdb), & & new_unittest("valid-qchem", test_qchem), & & new_unittest("valid-qcschema", test_qcschema, should_fail=.not.get_mctc_feature("json")), & & new_unittest("valid-vasp", test_vasp), & & new_unittest("valid-coord", test_coord), & & new_unittest("valid-xyz", test_xyz) & & ] end subroutine collect_write subroutine test_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".mol" call get_structure(struc, "mindless01") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_mol subroutine test_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".sdf" call get_structure(struc, "mindless02") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_sdf subroutine test_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".pdb" call get_structure(struc, "mindless03") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_pdb subroutine test_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".qchem" call get_structure(struc, "mindless04") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_qchem subroutine test_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".gen" call get_structure(struc, "x01") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_gen subroutine test_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".coord" call get_structure(struc, "x02") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_coord subroutine test_vasp(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".poscar" call get_structure(struc, "x03") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_vasp subroutine test_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".xyz" call get_structure(struc, "mindless04") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_xyz subroutine test_qcschema(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".json" call get_structure(struc, "mindless05") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_qcschema subroutine test_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc character(len=:), allocatable :: name integer :: unit name = get_name() // ".cjson" call get_structure(struc, "mindless06") call write_structure(struc, name, error) if (.not.allocated(error)) then call read_structure(struc, name, error) end if open(file=name, newunit=unit) close(unit, status='delete') end subroutine test_cjson function get_name() result(name) character(len=18) :: name real :: val call random_number(val) write(name, '(a, z8.8)') "mctc-test-", int(val*1.0e9) end function get_name end module test_write mctc-lib-0.3.2/test/test_write_aims.f90000066400000000000000000000050511466406626700177310ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_aims use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_aims use mctc_io_read_aims use mctc_io_structure implicit none private public :: collect_write_aims contains !> Collect all exported unit tests subroutine collect_write_aims(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-aims", test_valid1_aims), & & new_unittest("valid2-aims", test_valid2_aims) & & ] end subroutine collect_write_aims subroutine test_valid1_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_aims(struc, unit) rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_aims subroutine test_valid2_aims(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "x01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_aims(struc, unit) rewind(unit) call read_aims(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_aims end module test_write_aims mctc-lib-0.3.2/test/test_write_cjson.f90000066400000000000000000000055511466406626700201210ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_cjson use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_cjson use mctc_io_read_cjson use mctc_io_structure use mctc_version, only : get_mctc_feature implicit none private public :: collect_write_cjson contains !> Collect all exported unit tests subroutine collect_write_cjson(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) logical :: with_json with_json = get_mctc_feature("json") testsuite = [ & & new_unittest("valid1-cjson", test_valid1_cjson, should_fail=.not.with_json), & & new_unittest("valid2-cjson", test_valid2_cjson, should_fail=.not.with_json) & & ] end subroutine collect_write_cjson subroutine test_valid1_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") struc%comment = "mindless" nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_cjson(struc, unit) rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%comment, "mindless", "Comment no preserved") if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_cjson subroutine test_valid2_cjson(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "x01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_cjson(struc, unit) rewind(unit) call read_cjson(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_cjson end module test_write_cjson mctc-lib-0.3.2/test/test_write_ctfile.f90000066400000000000000000000050721466406626700202510ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_ctfile use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_ctfile use mctc_io_read_ctfile use mctc_io_structure implicit none private public :: collect_write_ctfile contains !> Collect all exported unit tests subroutine collect_write_ctfile(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-mol", test_valid1_mol), & & new_unittest("valid1-sdf", test_valid1_sdf) & & ] end subroutine collect_write_ctfile subroutine test_valid1_mol(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_molfile(struc, unit) rewind(unit) call read_molfile(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_mol subroutine test_valid1_sdf(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_sdf(struc, unit) rewind(unit) call read_sdf(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_sdf end module test_write_ctfile mctc-lib-0.3.2/test/test_write_gaussian.f90000066400000000000000000000036051466406626700206150ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_gaussian use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_gaussian use mctc_io_read_gaussian use mctc_io_structure implicit none private public :: collect_write_gaussian contains !> Collect all exported unit tests subroutine collect_write_gaussian(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-ein", test_valid1_ein) & & ] end subroutine collect_write_gaussian subroutine test_valid1_ein(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_gaussian_external(struc, unit) rewind(unit) call read_gaussian_external(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_ein end module test_write_gaussian mctc-lib-0.3.2/test/test_write_genformat.f90000066400000000000000000000066631466406626700207740ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_genformat use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_genformat use mctc_io_read_genformat use mctc_io_structure use mctc_io_structure_info implicit none private public :: collect_write_genformat contains !> Collect all exported unit tests subroutine collect_write_genformat(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-gen", test_valid1_gen), & & new_unittest("valid2-gen", test_valid2_gen), & & new_unittest("valid3-gen", test_valid3_gen) & & ] end subroutine collect_write_genformat subroutine test_valid1_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_genformat(struc, unit) rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_gen subroutine test_valid2_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "x01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_genformat(struc, unit) rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_gen subroutine test_valid3_gen(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc type(structure_info) :: info integer :: unit, nat, nid call get_structure(struc, "x02") nat = struc%nat nid = struc%nid info = structure_info(cartesian=.false.) struc%info = info open(status='scratch', newunit=unit) call write_genformat(struc, unit) rewind(unit) call read_genformat(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_gen end module test_write_genformat mctc-lib-0.3.2/test/test_write_pdb.f90000066400000000000000000000035061466406626700175500ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_pdb use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_pdb use mctc_io_read_pdb use mctc_io_structure implicit none private public :: collect_write_pdb contains !> Collect all exported unit tests subroutine collect_write_pdb(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-pdb", test_valid1_pdb) & & ] end subroutine collect_write_pdb subroutine test_valid1_pdb(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_pdb(struc, unit) rewind(unit) call read_pdb(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_pdb end module test_write_pdb mctc-lib-0.3.2/test/test_write_qchem.f90000066400000000000000000000051031466406626700200730ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_qchem use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_qchem use mctc_io_read_qchem use mctc_io_structure implicit none private public :: collect_write_qchem contains !> Collect all exported unit tests subroutine collect_write_qchem(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-qchem", test_valid1_qchem), & & new_unittest("valid2-qchem", test_valid2_qchem) & & ] end subroutine collect_write_qchem subroutine test_valid1_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_qchem(struc, unit) rewind(unit) call read_qchem(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_qchem subroutine test_valid2_qchem(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless02") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_qchem(struc, unit) rewind(unit) call read_qchem(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_qchem end module test_write_qchem mctc-lib-0.3.2/test/test_write_turbomole.f90000066400000000000000000000110261466406626700210070ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_turbomole use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_turbomole use mctc_io_read_turbomole use mctc_io_structure use mctc_io_convert, only : autoaa implicit none private public :: collect_write_turbomole contains !> Collect all exported unit tests subroutine collect_write_turbomole(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-coord", test_valid1_coord), & & new_unittest("valid2-coord", test_valid2_coord), & & new_unittest("valid1-coord-angs", test_valid1_coord_angs), & & new_unittest("valid2-coord-angs", test_valid2_coord_angs) & & ] end subroutine collect_write_turbomole subroutine test_valid1_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_coord(struc, unit) rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_coord subroutine test_valid2_coord(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "x01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_coord(struc, unit) rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_coord subroutine test_valid1_coord_angs(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid struc%xyz = struc%xyz * autoaa struc%info%angs_coord = .true. open(status='scratch', newunit=unit) call write_coord(struc, unit) rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return call check(error, struc%info%angs_coord, .true., "Coordinates are not written in angstrom.") if (allocated(error)) return end subroutine test_valid1_coord_angs subroutine test_valid2_coord_angs(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "x01") nat = struc%nat nid = struc%nid struc%xyz = struc%xyz * autoaa struc%lattice = struc%lattice * autoaa struc%info%angs_coord = .true. open(status='scratch', newunit=unit) call write_coord(struc, unit) rewind(unit) call read_coord(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return call check(error, struc%info%angs_coord, .true., "Coordinates are not written in angstrom.") if (allocated(error)) return end subroutine test_valid2_coord_angs end module test_write_turbomole mctc-lib-0.3.2/test/test_write_vasp.f90000066400000000000000000000103651466406626700177550ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_vasp use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_vasp use mctc_io_read_vasp use mctc_io_structure use mctc_io_structure_info implicit none private public :: collect_write_vasp contains !> Collect all exported unit tests subroutine collect_write_vasp(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-poscar", test_valid1_poscar), & & new_unittest("valid2-poscar", test_valid2_poscar), & & new_unittest("valid3-poscar", test_valid3_poscar), & & new_unittest("valid4-poscar", test_valid4_poscar) & & ] end subroutine collect_write_vasp subroutine test_valid1_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "x01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_vasp(struc, unit) rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_poscar subroutine test_valid2_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc type(structure_info) :: info integer :: unit, nat, nid call get_structure(struc, "x02") nat = struc%nat nid = struc%nid info = structure_info(selective=.true., cartesian=.false.) struc%info = info open(status='scratch', newunit=unit) call write_vasp(struc, unit, "x02") rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid2_poscar subroutine test_valid3_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc type(structure_info) :: info integer :: unit, nat, nid call get_structure(struc, "x03") nat = struc%nat nid = struc%nid info = structure_info(scale=0.5291772105638411) struc%info = info open(status='scratch', newunit=unit) call write_vasp(struc, unit) rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid3_poscar subroutine test_valid4_poscar(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_vasp(struc, unit) rewind(unit) call read_vasp(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid4_poscar end module test_write_vasp mctc-lib-0.3.2/test/test_write_xyz.f90000066400000000000000000000035061466406626700176350ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module test_write_xyz use mctc_env_testing, only : new_unittest, unittest_type, error_type, check use testsuite_structure, only : get_structure use mctc_io_write_xyz use mctc_io_read_xyz use mctc_io_structure implicit none private public :: collect_write_xyz contains !> Collect all exported unit tests subroutine collect_write_xyz(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & & new_unittest("valid1-xyz", test_valid1_xyz) & & ] end subroutine collect_write_xyz subroutine test_valid1_xyz(error) !> Error handling type(error_type), allocatable, intent(out) :: error type(structure_type) :: struc integer :: unit, nat, nid call get_structure(struc, "mindless01") nat = struc%nat nid = struc%nid open(status='scratch', newunit=unit) call write_xyz(struc, unit) rewind(unit) call read_xyz(struc, unit, error) close(unit) if (allocated(error)) return call check(error, struc%nat, nat, "Number of atoms does not match") if (allocated(error)) return call check(error, struc%nid, nid, "Number of species does not match") if (allocated(error)) return end subroutine test_valid1_xyz end module test_write_xyz mctc-lib-0.3.2/test/testsuite_structure.f90000066400000000000000000001051411466406626700207010ustar00rootroot00000000000000! This file is part of mctc-lib. ! ! Licensed under the Apache License, Version 2.0 (the "License"); ! you may not use this file except in compliance with the License. ! You may obtain a copy of the License at ! ! http://www.apache.org/licenses/LICENSE-2.0 ! ! Unless required by applicable law or agreed to in writing, software ! distributed under the License is distributed on an "AS IS" BASIS, ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ! See the License for the specific language governing permissions and ! limitations under the License. module testsuite_structure use mctc_env_accuracy, only : wp use mctc_io_structure, only : structure_type, new implicit none private public :: get_structure contains subroutine get_structure(self, name) type(structure_type), intent(out) :: self character(len=*), intent(in) :: name select case(name) case('mindless01'); call mindless01(self) case('mindless02'); call mindless02(self) case('mindless03'); call mindless03(self) case('mindless04'); call mindless04(self) case('mindless05'); call mindless05(self) case('mindless06'); call mindless06(self) case('mindless07'); call mindless07(self) case('mindless08'); call mindless08(self) case('mindless09'); call mindless09(self) case('mindless10'); call mindless10(self) case('x01'); call x01(self) case('x02'); call x02(self) case('x03'); call x03(self) case('x04'); call x04(self) case('x05'); call x05(self) end select end subroutine get_structure subroutine mindless01(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "Na", "H", "O", "H", "F", "H", "H", "O", "N", "H", "H", "Cl", "B", "B", "N", "Al"] real(wp), parameter :: xyz(3, nat) = reshape([& & -1.85528263484662_wp, 3.58670515364616_wp, -2.41763729306344_wp, & & 4.40178023537845_wp, 0.02338844412653_wp, -4.95457749372945_wp, & & -2.98706033463438_wp, 4.76252065456814_wp, 1.27043301573532_wp, & & 0.79980886075526_wp, 1.41103455609189_wp, -5.04655321620119_wp, & & -4.20647469409936_wp, 1.84275767548460_wp, 4.55038084858449_wp, & & -3.54356121843970_wp, -3.18835665176557_wp, 1.46240021785588_wp, & & 2.70032160109941_wp, 1.06818452504054_wp, -1.73234650374438_wp, & & 3.73114088824361_wp, -2.07001543363453_wp, 2.23160937604731_wp, & & -1.75306819230397_wp, 0.35951417150421_wp, 1.05323406177129_wp, & & 5.41755788583825_wp, -1.57881830078929_wp, 1.75394002750038_wp, & & -2.23462868255966_wp, -2.13856505054269_wp, 4.10922285746451_wp, & & 1.01565866207568_wp, -3.21952154552768_wp, -3.36050963020778_wp, & & 2.42119255723593_wp, 0.26626435093114_wp, -3.91862474360560_wp, & & -3.02526098819107_wp, 2.53667889095925_wp, 2.31664984740423_wp, & & -2.00438948664892_wp, -2.29235136977220_wp, 2.19782807357059_wp, & & 1.12226554109716_wp, -1.36942007032045_wp, 0.48455055461782_wp],& & shape(xyz)) call new(self, sym, xyz) end subroutine mindless01 subroutine mindless02(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "H", "S", "B", "O", "Mg", "H", "H", "H", "Si", "H", "B", "Li", "F", "H", "H", "S"] real(wp), parameter :: xyz(3, nat) = reshape([& & -1.79537625851198_wp, -3.77866422935275_wp, -1.07883558363403_wp, & & -2.68278833302782_wp, 0.38892666265890_wp, 1.66214865238427_wp, & & 0.11484649791305_wp, 1.48857933226955_wp, 3.65660396510375_wp, & & -1.07998879593946_wp, -0.16259121615748_wp, -4.55703065871422_wp, & & 0.60302832999383_wp, 4.08816149622342_wp, -0.02589373148029_wp, & & -1.22534089315880_wp, -1.79981382478068_wp, -3.70773173318592_wp, & & -1.33460982049866_wp, -4.24819082475503_wp, 2.72791902701083_wp, & & -0.16278082578516_wp, 2.41267994179303_wp, 5.69030695190570_wp, & & 2.87802444057103_wp, -0.33120525058830_wp, 1.88311373530297_wp, & & 0.68489327931487_wp, 0.32790204044961_wp, -4.20547693710673_wp, & & -1.20919773588330_wp, -2.87253762561437_wp, 0.94064204223101_wp, & & -3.25572604597922_wp, 2.21241092990940_wp, -2.86715549314771_wp, & & -1.83147468262373_wp, 5.20527293771933_wp, -2.26976270603341_wp, & & 4.90885865772880_wp, -1.92576561961811_wp, 2.99069919443735_wp, & & 1.26806242248758_wp, -2.60409341782411_wp, 0.55162805282247_wp, & & 4.11956976339902_wp, 1.59892866766766_wp, -1.39117477789609_wp],& & shape(xyz)) integer, parameter :: uhf = 2 call new(self, sym, xyz, uhf=uhf) end subroutine mindless02 subroutine mindless03(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "C", "O", "H", "Li", "Mg", "Al", "C", "H", "H", "H", "F", "S", "C", "H", "Na", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & -0.02148551327524_wp, -0.67161751504297_wp, -4.75078512817560_wp, & & 1.37792545875526_wp, -3.24818416423144_wp, 3.83896600631495_wp, & & -2.23986953822894_wp, 1.64550402751694_wp, 3.42773272178522_wp, & & -0.87622711432790_wp, -2.74068400827752_wp, 1.43723692979592_wp, & & 1.29492470653815_wp, 1.86470311043681_wp, -1.04536500695239_wp, & & -3.65768365013010_wp, 0.45437052179208_wp, -1.41566056087159_wp, & & -0.23245910487384_wp, -1.83274112101585_wp, -2.43395808606122_wp, & & 0.30373451850419_wp, -3.84228931776777_wp, -2.44882782867802_wp, & & -3.36159503902161_wp, 4.20056392581975_wp, 1.63352684198071_wp, & & 0.49372989648081_wp, -1.56245253044952_wp, -6.53610501083288_wp, & & 4.38566058812996_wp, 1.86127331114460_wp, 0.56178822055152_wp, & & -1.17545963764009_wp, 2.49456345795141_wp, -4.90195191215762_wp, & & -1.86623614216854_wp, 2.76329843590746_wp, 1.71572598870213_wp, & & 1.02361259176985_wp, -4.24377370348987_wp, 5.32418288889440_wp, & & 4.71194535010347_wp, -1.03648125005561_wp, 3.35573062118779_wp, & & -0.16051737061546_wp, 3.89394681976155_wp, 2.23776331451663_wp],& & shape(xyz)) call new(self, sym, xyz) end subroutine mindless03 subroutine mindless04(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "H", "B", "H", "F", "B", "H", "H", "Si", "H", "H", "C", "Al", "Si", "O", "H", "B"] real(wp), parameter :: xyz(3, nat) = reshape([& & -1.34544890768411_wp, 2.85946545334720_wp, 3.11183388215396_wp, & & -0.36293929605305_wp, 4.15983774640545_wp, 1.36413101934678_wp, & & -3.36268280924844_wp, 4.92951597114402_wp, -3.59085684882314_wp, & & 3.78143178536443_wp, -4.97181356229699_wp, 1.59003443639387_wp, & & 3.44227417874042_wp, -3.46504338606415_wp, 3.62082644591507_wp, & & 1.88917586252014_wp, 3.42088101960529_wp, 1.28872629783483_wp, & & -0.32747529934233_wp, -4.29711514977711_wp, -3.55330460209973_wp, & & -3.58768360829779_wp, -1.39509759062952_wp, -1.10396714572410_wp, & & -0.39440896193088_wp, 6.31837673143592_wp, 1.99105318714945_wp, & & 4.34376903295874_wp, -4.12502353873667_wp, 5.57829602371555_wp, & & -1.39570266622309_wp, -2.60410756418652_wp, -4.03149806979915_wp, & & 0.21788515354592_wp, 0.28610741675369_wp, 1.29731097788136_wp, & & -2.00000183598828_wp, 3.04473467156937_wp, -2.00578147078785_wp, & & 2.12833842504876_wp, -1.30141517432227_wp, 3.38069910888504_wp, & & -2.48411958079522_wp, -2.81581487156584_wp, -5.76829803496286_wp, & & -0.54241147261516_wp, -0.04348817268188_wp, -3.16920520707912_wp],& & shape(xyz)) call new(self, sym, xyz) end subroutine mindless04 subroutine mindless05(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "B", "P", "H", "H", "B", "P", "H", "Cl", "N", "H", "P", "Si", "H", "H", "P", "N"] real(wp), parameter :: xyz(3, nat) = reshape([& & 0.68391902268453_wp, 0.21679405065309_wp, -2.81441127558071_wp, & & -2.67199537993843_wp, -3.97743927106200_wp, 0.03497540139192_wp, & & 2.02325266152397_wp, -0.16048070975416_wp, -0.41980608052722_wp, & & 4.26224346168617_wp, 3.65384961705338_wp, -2.81836810458488_wp, & & -2.80378310343644_wp, 1.84796600006216_wp, 0.15107304476153_wp, & & 1.58317082705122_wp, 3.77079801391042_wp, -2.86230158107979_wp, & & 2.63670178694113_wp, 3.13142099211650_wp, 2.24139937019049_wp, & & -6.27112533979613_wp, -3.92471014080274_wp, 1.62562669834852_wp, & & -0.92594349239390_wp, -2.94451283088352_wp, 2.60616476876177_wp, & & -1.79532342290201_wp, -1.56841672860834_wp, 3.65515689388732_wp, & & -3.01460634915379_wp, -0.47748181717446_wp, -2.44834110183776_wp, & & 2.18249449208515_wp, -2.23505035804805_wp, 1.77725119258081_wp, & & 3.26068149442689_wp, -4.54078259646428_wp, 0.57204329987377_wp, & & 1.73744972267909_wp, -1.18654391698320_wp, -4.24063427353503_wp, & & 0.94405328902426_wp, 4.99525793054843_wp, 1.18501287451328_wp, & & -1.83118967048165_wp, 3.39933176543682_wp, 1.75515887283605_wp],& & shape(xyz)) integer, parameter :: uhf = 1 call new(self, sym, xyz, uhf=uhf) end subroutine mindless05 subroutine mindless06(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "B", "N", "H", "O", "B", "H", "Al", "H", "B", "Mg", "H", "H", "H", "H", "C", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & 0.10912945825730_wp, 1.64180252123600_wp, 0.27838149792131_wp, & & -2.30085163837888_wp, 0.87765138232225_wp, -0.60457694150897_wp, & & 2.78083551168063_wp, 4.95421363506113_wp, 0.40788634984219_wp, & & -5.36229602768251_wp, -7.29510945515334_wp, 0.06097106408867_wp, & & 2.13846114572058_wp, -0.99012126457352_wp, 0.93647189687052_wp, & & 0.09330150731888_wp, -2.75648066796634_wp, -3.70294675694565_wp, & & -1.52684105316140_wp, -2.44981814860506_wp, -1.02727325811774_wp, & & -0.45240334635443_wp, 5.86105501765814_wp, 0.30815308772432_wp, & & -3.95419048213910_wp, -5.52061943693205_wp, -0.31702321028260_wp, & & 2.68706169520082_wp, -0.13577304635533_wp, -3.57041492458512_wp, & & -3.79914135008731_wp, 2.06429808651079_wp, -0.77285245656187_wp, & & 0.89693752015341_wp, 4.58640300917890_wp, 3.09718012019731_wp, & & 2.76317093138142_wp, -0.62928000132252_wp, 3.08807601371151_wp, & & 1.00075543259914_wp, -3.11885279872042_wp, 1.08659460804098_wp, & & 0.86969979951508_wp, 4.43363816376984_wp, 1.02355776570620_wp, & & 4.05637089597643_wp, -1.52300699610852_wp, -0.29218485610105_wp],& & shape(xyz)) integer, parameter :: uhf = 1 call new(self, sym, xyz, uhf=uhf) end subroutine mindless06 subroutine mindless07(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "C", "H", "B", "H", "H", "Cl", "F", "N", "C", "H", "S", "H", "H", "O", "F", "Mg"] real(wp), parameter :: xyz(3, nat) = reshape([& & -3.75104222741336_wp, -5.81308736205268_wp, -1.22507366840233_wp, & & -1.45226572768296_wp, -3.01878767879831_wp, 2.38723142561073_wp, & & -1.99423317853240_wp, -3.52953889999752_wp, -1.30301724065129_wp, & & -4.33750965171233_wp, -6.65936981001909_wp, 0.55979831484564_wp, & & -4.51833920602637_wp, -6.72398616322561_wp, -2.90031439001886_wp, & & -1.25657105633503_wp, -2.39389339457851_wp, -4.58765484136593_wp, & & -0.14864209579028_wp, 4.40065007854051_wp, 1.35717716022989_wp, & & -0.91662354168326_wp, -2.22680612180354_wp, 0.71122632634918_wp, & & 1.83282041695179_wp, 5.36061635978157_wp, 3.22095765094686_wp, & & 0.66518416413161_wp, 6.30980889882630_wp, 4.62705414435961_wp, & & 3.68701623423530_wp, 2.79957532381681_wp, 4.21336212424745_wp, & & 1.69373321407504_wp, 0.01030275402386_wp, -3.74820290941150_wp, & & 3.35791986589808_wp, 2.52513229318111_wp, -3.46078430541625_wp, & & 2.79199182665654_wp, 1.01759578021447_wp, -2.59243571461852_wp, & & 3.05358934464082_wp, 7.15252337445235_wp, 1.82164153773112_wp, & & 1.29297161858681_wp, 0.78926456763834_wp, 0.91903438556425_wp],& & shape(xyz)) integer, parameter :: uhf = 1 call new(self, sym, xyz, uhf=uhf) end subroutine mindless07 subroutine mindless08(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "C", "O", "B", "F", "H", "Al", "H", "H", "O", "B", "Be", "C", "H", "H", "B", "F"] real(wp), parameter :: xyz(3, nat) = reshape([& & -1.27823293129313_wp, 0.06442674490989_wp, 2.76980447300615_wp, & & 2.05039033278229_wp, 0.64690940303039_wp, -0.29571013189632_wp, & & -0.07388472989895_wp, 2.46033979750309_wp, -1.30590420482375_wp, & & 1.10019432741349_wp, 4.43501067437330_wp, -2.64796515354449_wp, & & -1.89008873387150_wp, 0.02064696008121_wp, 4.74727599156952_wp, & & 0.81013963557610_wp, 1.41165582964016_wp, -6.35835508532445_wp, & & 2.51638337449170_wp, 1.74086425451198_wp, 3.45340860505386_wp, & & 2.62048878651566_wp, -1.58024532804571_wp, 2.87415150030394_wp, & & -0.92472602392464_wp, -3.37659091509259_wp, -0.68138826965952_wp, & & -2.19962829538645_wp, -2.53092502025386_wp, 1.35654623095955_wp, & & 0.92594749614406_wp, -1.61669775704536_wp, -1.93872059141561_wp, & & 1.63141903847248_wp, 0.18081362275364_wp, 2.42899361614054_wp, & & -3.96336280784845_wp, -3.68611886004249_wp, 2.18920954455515_wp, & & -1.17097381446263_wp, 1.08303722364990_wp, -3.04753977323348_wp, & & -2.18263847972349_wp, 2.31604957286801_wp, 1.11461091308323_wp, & & 2.02857282501340_wp, -1.56917620284149_wp, -4.65841766477431_wp],& & shape(xyz)) integer, parameter :: uhf = 1 call new(self, sym, xyz, uhf=uhf) end subroutine mindless08 subroutine mindless09(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "H", "H", "H", "H", "Li", "H", "C", "B", "H", "H", "Si", "H", "Cl", "F", "H", "B"] real(wp), parameter :: xyz(3, nat) = reshape([& & 3.97360649552839_wp, 1.71723751297383_wp, -0.51862929250676_wp, & & 0.16903666216522_wp, 1.73154352333176_wp, -0.40099024352959_wp, & & -3.94463844105182_wp, -1.24346369608005_wp, 0.09565841726334_wp, & & 2.21647168119803_wp, 4.10625979391554_wp, 2.61391340002321_wp, & & -0.04488993380842_wp, -2.16288302687041_wp, 4.48488595610432_wp, & & 3.52287141817194_wp, -0.90500888687059_wp, -5.00916337263077_wp, & & 1.95336082370762_wp, -0.83849036872324_wp, -3.65515970516029_wp, & & 2.05706981818495_wp, 1.70095588601056_wp, -2.06303335904159_wp, & & -6.40097100472159_wp, -1.71072935987273_wp, 3.14621771036234_wp, & & 2.04751538182937_wp, -2.55691868000982_wp, -2.49926722310562_wp, & & 2.03251078714394_wp, 1.35094356516468_wp, 2.02150308748654_wp, & & 0.20477572129201_wp, -0.93291693232462_wp, -4.76431390827476_wp, & & -2.67673272939098_wp, 1.40764602033672_wp, 4.10347165469140_wp, & & -2.75901984658887_wp, -3.73954809548334_wp, 3.19373273207227_wp, & & 1.96938102642596_wp, 3.74070925169244_wp, -3.03185101883736_wp, & & -4.32034786008576_wp, -1.66533650719069_wp, 2.28302516508337_wp],& & shape(xyz)) call new(self, sym, xyz) end subroutine mindless09 subroutine mindless10(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=2) ::& & "H", "Si", "H", "Cl", "C", "H", "F", "H", "C", "N", "B", "H", "Mg", "C", "H", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & 3.57062307661218_wp, -1.68792229443234_wp, 2.78939425857465_wp, & & -2.08994110527129_wp, 3.25317728228563_wp, -0.42147881550833_wp, & & 2.13532981939105_wp, -1.71356933061236_wp, -2.49234593851880_wp, & & -2.46885241522113_wp, -4.41076598859264_wp, -0.58746410797603_wp, & & 3.86605901148259_wp, -0.50808683490216_wp, 1.10929274542242_wp, & & -4.57284898019279_wp, -1.54920337824862_wp, -2.63711913350102_wp, & & -4.99945502320431_wp, 0.09990896897876_wp, -3.20268495970371_wp, & & 1.63618508154720_wp, 2.66791559582643_wp, -3.16904643876699_wp, & & -2.28445827511587_wp, 0.42792856662334_wp, 2.04433546457507_wp, & & 0.78486183614848_wp, 1.96692225005484_wp, -1.58921219981020_wp, & & -0.92003258313224_wp, -1.56076484060483_wp, 0.46494611026243_wp, & & -1.07970143095156_wp, 1.19037461384346_wp, 3.56880222429743_wp, & & 3.27327901654007_wp, 3.47628642644825_wp, 1.85050408639730_wp, & & 1.64922592697103_wp, -0.66726875777723_wp, -0.77306391492380_wp, & & 5.67004330685832_wp, -1.05218123504276_wp, 0.25282456342591_wp, & & -4.17031726246173_wp, 0.06724895615223_wp, 2.79231605575371_wp],& & shape(xyz)) integer, parameter :: uhf = 1 call new(self, sym, xyz, uhf=uhf) end subroutine mindless10 subroutine x01(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 32 character(len=*), parameter :: sym(nat) = [character(len=4) ::& & "O", "O", "O", "O", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", & & "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", & & "H", "H", "H", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & 8.66499304004865_wp, 9.33379706146984_wp, 7.91683397818847_wp, & & 11.12335640640559_wp, 2.15906103856442_wp, 12.28606540623589_wp, & & 2.69933763795316_wp, 8.69604933222823_wp, 5.94619038919326_wp, & & 4.40748472136020_wp, 2.73477407301820_wp, 1.34585013180550_wp, & & 8.94474331294941_wp, 5.24347823723191_wp, 6.03793064749213_wp, & & 10.69920497119952_wp, 4.18256695916720_wp, 4.01290993162606_wp, & & 10.03588165896165_wp, 5.08392793928533_wp, 1.39546189302066_wp, & & 8.49376544841568_wp, 7.47023679468653_wp, 1.28534952220463_wp, & & 9.07166275596235_wp, 9.29463739048189_wp, 3.43672461445391_wp, & & 8.87252167134021_wp, 8.08457959995134_wp, 6.01243046499065_wp, & & 2.61511156242260_wp, 9.98111860346994_wp, 7.83909475310702_wp, & & 1.94055488237084_wp, 8.92607461070971_wp, 10.39160309677660_wp, & & 3.94058158183755_wp, 9.62934843688878_wp, 12.34968145677051_wp, & & 4.41149849250265_wp, -0.13918998706016_wp, 12.14066417045890_wp, & & 4.70428751489632_wp, 1.17418327733924_wp, 9.63142334925047_wp, & & 2.97542523741995_wp, 0.23498193061563_wp, 7.50807857572976_wp, & & 11.00218693527931_wp, 10.01811156711939_wp, 3.26258886294108_wp, & & 6.51725105145864_wp, 6.87025658460207_wp, 1.40398487849503_wp, & & 9.16505707508531_wp, 6.55996790419566_wp, 12.22499217557358_wp, & & 0.47155553650782_wp, 4.68566204197289_wp, 3.97665598787901_wp, & & 10.71305929405516_wp, 2.12295125271661_wp, 4.04673290893442_wp, & & 7.00559444915079_wp, 4.60292552897028_wp, 5.68707427274543_wp, & & 7.82621004905011_wp, 10.93721749961744_wp, 3.36440794575946_wp, & & 9.47562563356497_wp, 4.56669825883223_wp, 7.90994201013468_wp, & & 5.72226645413659_wp, 8.73073901566233_wp, 11.81706046742993_wp, & & 1.10806523402693_wp, 1.08795999732802_wp, 7.75198050780745_wp, & & 4.49303750240828_wp, 3.20681326576017_wp, 9.88850009827761_wp, & & 3.68234836535172_wp, 0.82971735354827_wp, 5.66899365523961_wp, & & 6.67318941946786_wp, 0.84421918391682_wp, 9.09225122218742_wp, & & 12.30020769805011_wp, 9.84555048261104_wp, 11.35093359840778_wp, & & 1.70097366892267_wp, 6.88253129604813_wp, 10.28258692216369_wp, & & 3.02585151643235_wp, 10.74223721977969_wp, 1.45047192019470_wp],& & shape(xyz)) real(wp), parameter :: lattice(3, 3) = reshape([& & 12.17191845_wp, 0.09308248_wp, 0.41423668_wp, & & 0.08731987_wp, 12.55440630_wp, 0.31568135_wp, & & 0.42750296_wp, -1.80907922_wp, 12.77606779_wp],& & shape(lattice)) call new(self, sym, xyz, lattice=lattice) end subroutine x01 subroutine x02(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 32 character(len=*), parameter :: sym(nat) = [character(len=4) ::& & "O", "O", "O", "O", "O", "O", "O", "O", "C", "C", "C", "C", "C", "C", & & "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", & & "H", "H", "H", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & 4.63745097550818_wp, 2.37915954409831_wp, 19.12271349268357_wp, & & 6.72709904800693_wp, 0.45406655172709_wp, 16.05143697871524_wp, & & 6.91256964714223_wp, 2.38436998330633_wp, 6.39788951244788_wp, & & 4.82391466561283_wp, 0.46056271598603_wp, 3.32509104154164_wp, & & 1.18919515335071_wp, 5.93351886762742_wp, 9.40656871308612_wp, & & 3.27471753885763_wp, 7.86164871844023_wp, 6.33444054660705_wp, & & 0.99780233239929_wp, 7.85689402199700_wp, 19.06217051148892_wp, & & 3.08952816179886_wp, 5.93388907848718_wp, 22.13323554052032_wp, & & 5.35416029613234_wp, 2.30873365987837_wp, 16.93028032095304_wp, & & 4.75001882722751_wp, 4.26813080508463_wp, 14.98920903273459_wp, & & 6.19847745199579_wp, 2.31366251977415_wp, 4.20458897657195_wp, & & 6.80665649236884_wp, 4.27192054545680_wp, 2.26362280139482_wp, & & 3.16548840193314_wp, 9.74798782169150_wp, 10.46928111352906_wp, & & 2.56099108285706_wp, 7.78911812897077_wp, 8.52781851045641_wp, & & 1.71531586300926_wp, 7.78766523049261_wp, 21.25437643855244_wp, & & 1.11185021611237_wp, 9.74796815379632_wp, 23.19468740594458_wp, & & 3.61329543151651_wp, 3.43205969905233_wp, 13.49003378404895_wp, & & 7.17673435114791_wp, 10.13506068796258_wp, 17.37760565299595_wp, & & 3.71404617620063_wp, 5.82813222850270_wp, 15.82034897510546_wp, & & 6.46923526186126_wp, 4.97322450985026_wp, 14.10746213158056_wp, & & 5.08841444241702_wp, 4.98373937264637_wp, 1.38536619864770_wp, & & 0.56730092315824_wp, 5.82834639286665_wp, 3.09197971230966_wp, & & 0.65639014106239_wp, 3.43360236266220_wp, 0.75941943516012_wp, & & 4.37810806504803_wp, 10.14190879051040_wp, 4.65109383610143_wp, & & 4.20736555115953_wp, 0.34920021575627_wp, 9.63882258640363_wp, & & 4.29177512440358_wp, 8.91048751253497_wp, 11.97544245280817_wp, & & 0.74057850072650_wp, 4.66235021937769_wp, 8.08112406897593_wp, & & 1.44463798101514_wp, 10.46104535442793_wp, 11.34128971196497_wp, & & 0.06308951988013_wp, 0.34832836424057_wp, 22.36345606641216_wp, & & -0.01363861729261_wp, 8.91069125987469_wp, 24.70168579125730_wp, & & 2.83286106954203_wp, 10.46215767099852_wp, 24.06567365395194_wp, & & 3.53590396893376_wp, 4.66141487828773_wp, 20.80838381072642_wp],& & shape(xyz)) real(wp), parameter :: lattice(3, 3) = reshape([& & 7.28162822_wp, -0.00060036_wp, 0.00257376_wp, & & 0.00297342_wp, 10.95374740_wp, 0.00144914_wp, & & -0.01715980_wp, -0.00425337_wp, 25.44979900_wp],& & shape(lattice)) call new(self, sym, xyz, lattice=lattice) end subroutine x02 subroutine x03(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 52 character(len=*), parameter :: sym(nat) = [character(len=4) ::& & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", & & "C", "C", "C", "C", "C", "C", "H", "H", "H", "H", "H", "H", "H", "H", & & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", & & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & 6.85499925334061_wp, 0.58339620591570_wp, 15.88596621412105_wp, & & 9.24413370501684_wp, 2.95651635041689_wp, 2.46485240796786_wp, & & 5.31512352904071_wp, 9.21510777326209_wp, 9.20126499327503_wp, & & 2.94513117890964_wp, 6.85725126528710_wp, 5.80174646207598_wp, & & 0.57238636973286_wp, 9.22086291490312_wp, 9.19505291377807_wp, & & 2.95101143232547_wp, 11.60011353636975_wp, 5.81736060783860_wp, & & 2.94175316098990_wp, 9.21047863759430_wp, 10.88860009988064_wp, & & 5.31187062289578_wp, 6.85199657074529_wp, 7.49949099919000_wp, & & 5.31674998211317_wp, 11.58947903551133_wp, 7.51493725091216_wp, & & 2.95263788539794_wp, 9.23399965125764_wp, 4.11911238860320_wp, & & 0.57451326990455_wp, 6.85762660061152_wp, 7.49311102565259_wp, & & 9.20935263162105_wp, 2.94137782566549_wp, 12.48510453059833_wp, & & 9.23462521013167_wp, 5.32488224747550_wp, 0.76979417550117_wp, & & 11.58885347663730_wp, 2.94563162600886_wp, 14.16404493518103_wp, & & 9.23174763931115_wp, 0.58201997639285_wp, 0.77919624176683_wp, & & 6.85862749480996_wp, 5.32025311180771_wp, 15.87606046573401_wp, & & 6.84586609377985_wp, 2.94825897327976_wp, 14.18704641872381_wp, & & 11.59535928892716_wp, 5.31737554098720_wp, 15.85373055835306_wp, & & 0.57989307622116_wp, 11.59410817117911_wp, 7.50771780717246_wp, & & 11.59248171810665_wp, 0.57989307622116_wp, 15.86330051865918_wp, & & 5.11732181307401_wp, 0.55412005061133_wp, 0.27349939190652_wp, & & 7.06155879354367_wp, 11.62288387938426_wp, 6.34908103396994_wp, & & 5.10243351187221_wp, 2.94813386150496_wp, 13.01380286400142_wp, & & 0.82974129050674_wp, 0.55111736801601_wp, 0.23471586856066_wp, & & 11.62375966180790_wp, 7.05930678159717_wp, 14.68300541423754_wp, & & 6.82459709206300_wp, 7.05993234047120_wp, 14.70231322889024_wp, & & 0.54636312057342_wp, 0.82323547821688_wp, 8.68012189169256_wp, & & 9.23550099255530_wp, 11.35727158147325_wp, 1.96419237932130_wp, & & 1.26100157825957_wp, 9.24175658129555_wp, 2.87552123092879_wp, & & 2.93774958419614_wp, 7.50645626475024_wp, 12.11422659522601_wp, & & 4.65465846984512_wp, 9.23550099255530_wp, 2.89079958861049_wp, & & 2.94362983761198_wp, 10.90023826811060_wp, 12.13487756220238_wp, & & 2.95351366782157_wp, 0.83074218470518_wp, 4.64159864250933_wp, & & 11.34400973334392_wp, 9.21861090295662_wp, 10.37383697183559_wp, & & 2.94513117890964_wp, 5.12307695471503_wp, 4.61456770199555_wp, & & 11.35089088095820_wp, 11.62838879747568_wp, 6.33464214649053_wp, & & 0.54285999087888_wp, 5.11244245385661_wp, 8.65846356047344_wp, & & 7.05542831657822_wp, 6.82334597431495_wp, 6.33162005376228_wp, & & 0.83124263180440_wp, 5.34690191984118_wp, 0.22699274269958_wp, & & 5.34840326113884_wp, 0.81710500125144_wp, 8.69019553412005_wp, & & 7.05167496333407_wp, 9.21022841404469_wp, 10.38525376658675_wp, & & 5.12057471921893_wp, 5.35666063827596_wp, 0.26208259715536_wp, & & 6.81821639154794_wp, 11.34963976321015_wp, 14.72044578525974_wp, & & 10.95128387223103_wp, 2.95826791526416_wp, 3.68611365826132_wp, & & 9.20284681933119_wp, 1.23885679411908_wp, 11.25746330676746_wp, & & 7.55775209242028_wp, 2.95864325058858_wp, 3.71566300938197_wp, & & 9.20272170755639_wp, 4.63263879747945_wp, 11.24084179676209_wp, & & 9.24150635774594_wp, 7.06506192323821_wp, 1.94773876335639_wp, & & 0.81009874186236_wp, 2.94200338453951_wp, 12.97434776449373_wp, & & 5.33952032512768_wp, 5.10481063559351_wp, 8.66249301744444_wp, & & 11.34300883914548_wp, 6.83035223370403_wp, 6.32356113982028_wp, & & 11.61750407306765_wp, 11.34613663351561_wp, 14.69710851363604_wp],& & shape(xyz)) real(wp), parameter :: lattice(3, 3) = reshape([& & 12.51117748_wp, 0.00000000_wp, 0.00000000_wp, & & 0.00000000_wp, 12.51117748_wp, 0.00000000_wp, & & 0.00000000_wp, 0.00000000_wp, 16.78940405_wp],& & shape(lattice)) call new(self, sym, xyz, lattice=lattice) end subroutine x03 subroutine x04(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 16 character(len=*), parameter :: sym(nat) = [character(len=4) ::& & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "N", "N", & & "N", "N"] real(wp), parameter :: xyz(3, nat) = reshape([& & 4.15467418193883_wp, 3.33328901394025_wp, 1.66323391111685_wp, & & 3.33328901394025_wp, 1.66323391111685_wp, 4.15467418193883_wp, & & 1.66323391111685_wp, 4.15467418193883_wp, 3.33328901394025_wp, & & 9.14844968255857_wp, 3.06025186813034_wp, 9.33489558920461_wp, & & 8.23223100208403_wp, 4.72395947311570_wp, 6.86439258737082_wp, & & 6.65104086899334_wp, 2.17993918288896_wp, 7.71770472210706_wp, & & 7.71770472210706_wp, 6.65104086899334_wp, 2.17993918288896_wp, & & 9.33489558920461_wp, 9.14844968255857_wp, 3.06025186813034_wp, & & 6.86439258737082_wp, 8.23223100208403_wp, 4.72395947311570_wp, & & 4.72395947311570_wp, 6.86439258737082_wp, 8.23223100208403_wp, & & 2.17993918288896_wp, 7.71770472210706_wp, 6.65104086899334_wp, & & 3.06025186813034_wp, 9.33489558920461_wp, 9.14844968255857_wp, & & 2.59764243614222_wp, 2.59764243614222_wp, 2.59764243614222_wp, & & 7.55541720275509_wp, 3.76255039758519_wp, 8.43506671658056_wp, & & 8.43506671658056_wp, 7.55541720275509_wp, 3.76255039758519_wp, & & 3.76255039758519_wp, 8.43506671658056_wp, 7.55541720275509_wp],& & shape(xyz)) real(wp), parameter :: lattice(3, 3) = reshape([& & 9.47387737_wp, 0.00000000_wp, 0.00000000_wp, & & 0.00000000_wp, 9.47387737_wp, 0.00000000_wp, & & 0.00000000_wp, 0.00000000_wp, 9.47387737_wp],& & shape(lattice)) call new(self, sym, xyz, lattice=lattice) end subroutine x04 subroutine x05(self) type(structure_type), intent(out) :: self integer, parameter :: nat = 48 character(len=*), parameter :: sym(nat) = [character(len=4) ::& & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", & & "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", "C", & & "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", "H", & & "H", "H", "H", "H", "H", "H"] real(wp), parameter :: xyz(3, nat) = reshape([& & 9.36760291026725_wp, 7.80244140446007_wp, 2.94420668811823_wp, & & -2.60635659089003_wp, 11.13901918927945_wp, 16.83643328201347_wp, & & 7.22248107756189_wp, 8.57559920837242_wp, 7.03672928400636_wp, & & -1.76362632094559_wp, 0.64297750017893_wp, 14.40186664953440_wp, & & 5.83962338438617_wp, 10.13957405739921_wp, 8.57608868644902_wp, & & -0.31075648460643_wp, 10.41940511029398_wp, 12.90511986423551_wp, & & 0.36884840129967_wp, 7.95718616550666_wp, 13.74008757124138_wp, & & 5.13899142512075_wp, 1.27780458134152_wp, 7.74094984443455_wp, & & -0.43135113991668_wp, 7.08361972732341_wp, 16.04852770237523_wp, & & 5.85948725126428_wp, 2.12703296273982_wp, 5.39640022648409_wp, & & 7.98202471665911_wp, 9.37739667910611_wp, 4.56827791982260_wp, & & 2.58521074631042_wp, 6.23620255015096_wp, 0.63970266218240_wp, & & -7.37287492489702_wp, 6.83831475498402_wp, 13.72263180036320_wp, & & -0.33592003395561_wp, 6.47879071615157_wp, 7.13632985901710_wp, & & -9.65567668851609_wp, 2.93064163769937_wp, 14.45885460740137_wp, & & 0.44488747834642_wp, 5.60046986687546_wp, 4.70073641648637_wp, & &-10.35051844686700_wp, 3.77330440377895_wp, 16.93226888683481_wp, & & -2.67740619557892_wp, 2.59670085855714_wp, 7.83370501910091_wp, & & -8.03719513476919_wp, 7.73259684150050_wp, 16.06666801328784_wp, & & -1.95562894546284_wp, 1.67604311050164_wp, 5.51722154256241_wp, & & 1.91027980799140_wp, 7.09482655347090_wp, 3.06297438409324_wp, & & -8.19632876596279_wp, 4.41220669444970_wp, 12.90802915938188_wp, & & 8.06439765037426_wp, 1.37696801270714_wp, 1.32184680649995_wp, & & 0.30124800389322_wp, 2.27996651956055_wp, 1.45618778825843_wp, & & 10.17812550339424_wp, 8.63514254729744_wp, 0.55738672304122_wp, & & 7.30609985362735_wp, 0.55954890552544_wp, 3.73485042789423_wp, & & -1.86811945051845_wp, 5.02597852648671_wp, 8.64608290497032_wp, & & -0.39194685290862_wp, 3.14311853344512_wp, 3.87021821970436_wp, & & 0.34646325134892_wp, 11.08026825220325_wp, 11.06935462688116_wp, & & 5.28103743231810_wp, 9.50927498680126_wp, 10.45446654094714_wp, & & -2.26789230598577_wp, 2.53398791223687_wp, 13.76284852738644_wp, & & 7.76197910212852_wp, 6.69602202299020_wp, 7.67831443128346_wp, & & 9.83472737946160_wp, 5.89603575648236_wp, 3.55909477405225_wp, & & 5.35897816853694_wp, 4.02359018773944_wp, 4.77723376533483_wp, & & 7.54765344185304_wp, 3.26594082001099_wp, 0.68608024951558_wp, & & -6.21783671028862_wp, 7.98605223285624_wp, 12.46513175710043_wp, & & -3.91122464008637_wp, 1.48801747180495_wp, 9.05064606532323_wp, & & -2.61184696118149_wp, 11.15215041991691_wp, 4.87991477050055_wp, & & -0.35396280221428_wp, 0.43333061103608_wp, 0.82127690631710_wp, & & 2.51885417779770_wp, 8.96364971376210_wp, 3.67683565997560_wp, & & 5.60295691186475_wp, 1.08117572257201_wp, 13.82633961558057_wp, & & 0.27625154557950_wp, 8.34365186719871_wp, 7.75926129035577_wp, & & -7.67466304247654_wp, 3.74319313352409_wp, 11.03238946502150_wp, & & -2.49374222683799_wp, 5.73280097562707_wp, 10.47517387698890_wp, & & 1.55529102490321_wp, 6.77673381130491_wp, 12.54402499606942_wp, & & 4.03617550083984_wp, 2.48938700817517_wp, 8.98510135702578_wp, & & -7.43995626641283_wp, 9.60481600971518_wp, 16.67385502383442_wp, & & 0.10707944729661_wp, 5.20506134431823_wp, 16.69319327980730_wp],& & shape(xyz)) real(wp), parameter :: lattice(3, 3) = reshape([& & 15.90091151_wp, 0.00000000_wp, 0.00000000_wp, & & 0.00000000_wp, 11.32002641_wp, 0.00000000_wp, & &-12.11389533_wp, 0.00000000_wp, 17.11350086_wp],& & shape(lattice)) call new(self, sym, xyz, lattice=lattice) end subroutine x05 end module testsuite_structure