diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 16d48ff2..5b04c74a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -144,7 +144,7 @@ jobs: if: ${{ matrix.build == 'fpm' }} uses: fortran-lang/setup-fpm@v3 with: - fpm-version: 'v0.2.0' + fpm-version: 'v0.3.0' - name: Prepare for cache restore if: ${{ matrix.compiler == 'intel' }} diff --git a/CMakeLists.txt b/CMakeLists.txt index 327427c1..b761907f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -27,6 +27,11 @@ 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") @@ -36,6 +41,18 @@ add_library( "${PROJECT_NAME}-lib" "${srcs}" ) +target_compile_definitions( + "${PROJECT_NAME}-lib" + PRIVATE + "WITH_JSON=$" +) +if(WITH_JSON) + target_link_libraries( + "${PROJECT_NAME}-lib" + PRIVATE + "jsonfortran::jsonfortran" + ) +endif() set_target_properties( "${PROJECT_NAME}-lib" PROPERTIES @@ -48,6 +65,7 @@ set_target_properties( target_include_directories( "${PROJECT_NAME}-lib" PUBLIC + $ $ $ $ diff --git a/README.md b/README.md index 6ad55873..8bcd655d 100644 --- a/README.md +++ b/README.md @@ -11,11 +11,11 @@ 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.53 or newer, with +- [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.2.0 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. diff --git a/config/CMakeLists.txt b/config/CMakeLists.txt index 7e797f4f..80d33e63 100644 --- a/config/CMakeLists.txt +++ b/config/CMakeLists.txt @@ -15,6 +15,7 @@ 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( module-dir @@ -22,6 +23,14 @@ set( ) 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}" +) + # Set build type as CMake does not provide defaults if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) set( @@ -53,6 +62,17 @@ install( 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" diff --git a/config/cmake/Findjsonfortran.cmake b/config/cmake/Findjsonfortran.cmake new file mode 100644 index 00000000..81d794c2 --- /dev/null +++ b/config/cmake/Findjsonfortran.cmake @@ -0,0 +1,30 @@ +# 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() diff --git a/config/meson.build b/config/meson.build index dfe535e8..5b20cb7b 100644 --- a/config/meson.build +++ b/config/meson.build @@ -46,3 +46,14 @@ 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 diff --git a/config/template.cmake b/config/template.cmake index 3a6ae000..0268d954 100644 --- a/config/template.cmake +++ b/config/template.cmake @@ -1,6 +1,7 @@ @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") @@ -10,4 +11,8 @@ if(NOT TARGET "@PROJECT_NAME@::@PROJECT_NAME@") 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() diff --git a/config/template.pc b/config/template.pc index 3d6efbb5..84c3498c 100644 --- a/config/template.pc +++ b/config/template.pc @@ -4,6 +4,7 @@ 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@ diff --git a/doc/format-qcschema.md b/doc/format-qcschema.md new file mode 100644 index 00000000..b4db691c --- /dev/null +++ b/doc/format-qcschema.md @@ -0,0 +1,94 @@ +--- +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. diff --git a/doc/index.md b/doc/index.md index 792733a2..a59df38a 100644 --- a/doc/index.md +++ b/doc/index.md @@ -11,3 +11,4 @@ This library supports reading and writing of the following formats: - [a subset of PDB format](./format-pdb.html) - [DFTB+ general format](./format-gen.html) - [Gaussian external format](./format-ein.html) +- [QCSchema JSON format](./format-qcschema.html) diff --git a/fpm.toml b/fpm.toml index 0586ad65..973895e9 100644 --- a/fpm.toml +++ b/fpm.toml @@ -6,3 +6,6 @@ author = ["Sebastian Ehlert"] copyright = "2020-2021 Sebastian Ehlert" description = "Modular computation tool chain library" keywords = ["computational-chemistry", "io"] + +[dependencies] +json-fortran.git = "https://github.com/jacobwilliams/json-fortran.git" diff --git a/include/mctc/defs.h b/include/mctc/defs.h new file mode 100644 index 00000000..0e7925ca --- /dev/null +++ b/include/mctc/defs.h @@ -0,0 +1,8 @@ +#ifndef mctc_defs_fh +#define mctc_defs_fh + +#ifndef WITH_JSON +#define WITH_JSON 1 +#endif + +#endif diff --git a/man/mctc-convert.1.adoc b/man/mctc-convert.1.adoc index 0d090cd0..23823ed9 100644 --- a/man/mctc-convert.1.adoc +++ b/man/mctc-convert.1.adoc @@ -26,6 +26,7 @@ Supported formats: - 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) == Options diff --git a/meson.build b/meson.build index 5c2000d3..3b4339f6 100644 --- a/meson.build +++ b/meson.build @@ -17,7 +17,7 @@ project( 'fortran', version: '0.2.3', license: 'Apache-2.0', - meson_version: '>=0.53', + meson_version: '>=0.55', default_options: [ 'buildtype=debugoptimized', 'default_library=both', @@ -38,7 +38,11 @@ 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, ) diff --git a/meson_options.txt b/meson_options.txt index 1bd87b7c..fc24d75d 100644 --- a/meson_options.txt +++ b/meson_options.txt @@ -19,3 +19,11 @@ option( yield: true, description: 'use OpenMP parallelisation', ) + +option( + 'json', + type: 'feature', + value: 'auto', + yield: true, + description: 'support JSON input', +) diff --git a/src/mctc/CMakeLists.txt b/src/mctc/CMakeLists.txt index e6cc698f..89bb8407 100644 --- a/src/mctc/CMakeLists.txt +++ b/src/mctc/CMakeLists.txt @@ -21,7 +21,7 @@ list( APPEND srcs "${dir}/env.f90" "${dir}/io.f90" - "${dir}/version.f90" + "${dir}/version.F90" ) set(srcs "${srcs}" PARENT_SCOPE) diff --git a/src/mctc/io/read.f90 b/src/mctc/io/read.f90 index e125f0fc..5d27d584 100644 --- a/src/mctc/io/read.f90 +++ b/src/mctc/io/read.f90 @@ -18,6 +18,7 @@ module mctc_io_read 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_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 @@ -143,6 +144,9 @@ subroutine get_structure_reader(reader, ftype) case(filetype%molfile) reader => read_molfile + case(filetype%qcschema) + reader => read_qcschema + case(filetype%pdb) reader => read_pdb diff --git a/src/mctc/io/read/CMakeLists.txt b/src/mctc/io/read/CMakeLists.txt index 7ac512da..e8eb70eb 100644 --- a/src/mctc/io/read/CMakeLists.txt +++ b/src/mctc/io/read/CMakeLists.txt @@ -19,6 +19,7 @@ list( "${dir}/ctfile.f90" "${dir}/gaussian.f90" "${dir}/genformat.f90" + "${dir}/qcschema.F90" "${dir}/pdb.f90" "${dir}/turbomole.f90" "${dir}/vasp.f90" diff --git a/src/mctc/io/read/meson.build b/src/mctc/io/read/meson.build index b8629ee6..ef9e0407 100644 --- a/src/mctc/io/read/meson.build +++ b/src/mctc/io/read/meson.build @@ -16,6 +16,7 @@ srcs += files( 'ctfile.f90', 'gaussian.f90', 'genformat.f90', + 'qcschema.F90', 'pdb.f90', 'turbomole.f90', 'vasp.f90', diff --git a/src/mctc/io/read/qcschema.F90 b/src/mctc/io/read/qcschema.F90 new file mode 100644 index 00000000..893129a8 --- /dev/null +++ b/src/mctc/io/read/qcschema.F90 @@ -0,0 +1,180 @@ +! 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 diff --git a/src/mctc/meson.build b/src/mctc/meson.build index 2653b243..d1e35b02 100644 --- a/src/mctc/meson.build +++ b/src/mctc/meson.build @@ -18,5 +18,5 @@ subdir('io') srcs += files( 'env.f90', 'io.f90', - 'version.f90', + 'version.F90', ) diff --git a/src/mctc/version.f90 b/src/mctc/version.F90 similarity index 77% rename from src/mctc/version.f90 rename to src/mctc/version.F90 index d9327ce7..5618b636 100644 --- a/src/mctc/version.f90 +++ b/src/mctc/version.F90 @@ -12,12 +12,14 @@ ! 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 + public :: get_mctc_version, get_mctc_feature !> String representation of the mctc-lib version @@ -27,6 +29,10 @@ module mctc_version integer, parameter :: mctc_version_compact(3) = [0, 2, 3] + !> With support for JSON + logical, parameter :: mctc_with_json = 0 /= WITH_JSON + + contains @@ -61,4 +67,22 @@ pure subroutine get_mctc_version(major, minor, patch, string) 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 diff --git a/subprojects/.gitignore b/subprojects/.gitignore new file mode 100644 index 00000000..3daff2f5 --- /dev/null +++ b/subprojects/.gitignore @@ -0,0 +1,2 @@ +/packagecache/ +/json-fortran-*/ diff --git a/subprojects/json-fortran-8.2.5.wrap b/subprojects/json-fortran-8.2.5.wrap new file mode 100644 index 00000000..3a8bf523 --- /dev/null +++ b/subprojects/json-fortran-8.2.5.wrap @@ -0,0 +1,8 @@ +[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 diff --git a/subprojects/packagefiles/json-fortran-8.2.5/meson.build b/subprojects/packagefiles/json-fortran-8.2.5/meson.build new file mode 100644 index 00000000..2dcadd39 --- /dev/null +++ b/subprojects/packagefiles/json-fortran-8.2.5/meson.build @@ -0,0 +1,28 @@ +project( + 'jsonfortran', + 'Fortran', + version: files('.VERSION'), +) + +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() +) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index a4b6ac59..3e1547f3 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -20,6 +20,7 @@ set( "read-ctfile" "read-gaussian" "read-genformat" + "read-qcschema" "read-pdb" "read-turbomole" "read-vasp" diff --git a/test/main.f90 b/test/main.f90 index c3058ddb..21e7f12e 100644 --- a/test/main.f90 +++ b/test/main.f90 @@ -23,6 +23,7 @@ program tester 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_qcschema, only : collect_read_qcschema use test_read_pdb, only : collect_read_pdb use test_read_turbomole, only : collect_read_turbomole use test_read_vasp, only : collect_read_vasp @@ -51,6 +52,7 @@ program tester & new_testsuite("read-ctfile", collect_read_ctfile), & & new_testsuite("read-gaussian", collect_read_gaussian), & & new_testsuite("read-genformat", collect_read_genformat), & + & new_testsuite("read-qcschema", collect_read_qcschema), & & new_testsuite("read-pdb", collect_read_pdb), & & new_testsuite("read-turbomole", collect_read_turbomole), & & new_testsuite("read-vasp", collect_read_vasp), & diff --git a/test/meson.build b/test/meson.build index 7edc9f34..f4a6ff02 100644 --- a/test/meson.build +++ b/test/meson.build @@ -18,6 +18,7 @@ tests = [ 'read-ctfile', 'read-gaussian', 'read-genformat', + 'read-qcschema', 'read-pdb', 'read-turbomole', 'read-vasp', diff --git a/test/test_read.f90 b/test/test_read.f90 index ecd6e655..b2a9ee07 100644 --- a/test/test_read.f90 +++ b/test/test_read.f90 @@ -18,6 +18,7 @@ module test_read 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 @@ -37,6 +38,7 @@ subroutine collect_read(testsuite) & new_unittest("valid-mol", test_mol), & & new_unittest("valid-sdf", test_sdf), & & new_unittest("valid-gen", test_gen), & + & new_unittest("valid-qcschema", test_qcschema, should_fail=.not.get_mctc_feature("json")), & & new_unittest("valid-pdb", test_pdb), & & new_unittest("valid-vasp", test_vasp), & & new_unittest("valid-coord", test_coord), & @@ -417,6 +419,96 @@ subroutine test_xyz(error) 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 + + function get_name() result(name) character(len=18) :: name diff --git a/test/test_read_qcschema.f90 b/test/test_read_qcschema.f90 new file mode 100644 index 00000000..54834588 --- /dev/null +++ b/test/test_read_qcschema.f90 @@ -0,0 +1,477 @@ +! 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 diff --git a/test/test_write.f90 b/test/test_write.f90 index 97597edc..f50e9592 100644 --- a/test/test_write.f90 +++ b/test/test_write.f90 @@ -18,6 +18,7 @@ module test_write 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 @@ -38,6 +39,7 @@ subroutine collect_write(testsuite) & new_unittest("valid-mol", test_mol), & & new_unittest("valid-sdf", test_sdf), & & new_unittest("valid-gen", test_gen), & + & new_unittest("valid-qcschema", test_qcschema, should_fail=.not.get_mctc_feature("json")), & & new_unittest("valid-pdb", test_pdb), & & new_unittest("valid-vasp", test_vasp), & & new_unittest("valid-coord", test_coord), & @@ -215,6 +217,30 @@ subroutine test_xyz(error) 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 + + function get_name() result(name) character(len=18) :: name