[pull] main from grimme-lab:main

app/main.f90

@@ -173,19 +173,19 @@ subroutine get_arguments(input, input_format, output, output_format, normalize,
       & template, template_format, read_dot_files, error)
 
    !> Input file name
-   character(len=:), allocatable :: input
+   character(len=:), allocatable, intent(out) :: input
 
    !> Input file format
    integer, allocatable, intent(out) :: input_format
 
    !> Output file name
-   character(len=:), allocatable :: output
+   character(len=:), allocatable, intent(out) :: output
 
    !> Output file format
    integer, allocatable, intent(out) :: output_format
 
    !> Template file name
-   character(len=:), allocatable :: template
+   character(len=:), allocatable, intent(out) :: template
 
    !> Template file format
    integer, allocatable, intent(out) :: template_format
@@ -340,6 +340,9 @@ subroutine read_file(filename, val, error)
    end if
 
    close(io, iostat=stat)
+   if (stat /= 0) then
+      call fatal_error(error, "Error: Could not close file '"//filename//"'")
+   end if
 
 end subroutine read_file
 

fpm.toml

@@ -44,11 +44,7 @@ jonquil = "https://toml-f.github.io/jonquil/module/jonquil.html"
 ignore = [
   "C002",  # interface without implicit none
   "C003",  # implicit none(external)
-  "C011",  # no default in select case
-  "C061",  # missing intent attribute
-  "C072",  # assumed size character intent
-  "C121",  # use without explicit only
-  "C122",  # intrinsic missing for internal modules
-  "C181",  # iostat not checked
 ]
+per-file-ignores."src/mctc/io/symbols.f90" = ["C072"]
+per-file-ignores."src/mctc/io/resize.f90" = ["C072"]
 line-length = 132

src/mctc/env/testing.f90

@@ -296,7 +296,7 @@ function select_test(tests, name) result(pos)
    character(len=*), intent(in) :: name
 
    !> Available unit tests
-   type(unittest_type) :: tests(:)
+   type(unittest_type), intent(in) :: tests(:)
 
    !> Selected test suite
    integer :: pos
@@ -321,7 +321,7 @@ function select_suite(suites, name) result(pos)
    character(len=*), intent(in) :: name
 
    !> Available test suites
-   type(testsuite_type) :: suites(:)
+   type(testsuite_type), intent(in) :: suites(:)
 
    !> Selected test suite
    integer :: pos

src/mctc/io/filetype.f90

@@ -140,6 +140,8 @@ elemental function get_filetype(file) result(ftype)
          ftype = filetype%pymatgen
       case("json")
          ftype = filetype%json
+      case default
+         continue
       end select
       if (ftype /= filetype%unknown) return
    else
@@ -158,6 +160,8 @@ elemental function get_filetype(file) result(ftype)
          ftype = filetype%tmol
       case("poscar", "contcar")
          ftype = filetype%vasp
+      case default
+         continue
       end select
    end if
 

src/mctc/io/read.f90

@@ -185,6 +185,8 @@ subroutine get_structure_reader(reader, ftype)
    case(filetype%json)
       reader => read_json
 
+   case default
+      nullify(reader)
    end select
 
 end subroutine get_structure_reader

src/mctc/io/read/ctfile.f90

@@ -431,6 +431,8 @@ subroutine read_molfile_v3k(self, unit, error)
                      case("HCOUNT")
                         token%first = equal + 1
                         call read_token(line, token, sdf(iatom)%hydrogens, stat)
+                     case default
+                        continue
                      end select
                   end if
                   if (stat /= 0) then
@@ -554,7 +556,7 @@ subroutine next_v30(unit, line, pos, lnum, iostat, iomsg)
    integer, intent(out) :: iostat
 
    !> Error message
-   character(len=:), allocatable, optional :: iomsg
+   character(len=:), allocatable, intent(out), optional :: iomsg
 
    call next_line(unit, line, pos, lnum, iostat, iomsg)
    if (iostat /= 0) return

src/mctc/io/read/turbomole.f90

@@ -232,6 +232,8 @@ subroutine read_coord(mol, unit, error)
             call next_line(unit, cell_string, pos, lnum, stat)
             if (debug) print*, cell_string
 
+         case default
+            continue
          end select
       end if
       token = token_type(0, 0)
@@ -311,6 +313,11 @@ subroutine read_coord(mol, unit, error)
 
    if (has_cell) then
       read(cell_string, *, iostat=stat) latvec(:p_ncp(periodic))
+      if (stat /= 0) then
+         call io_error(error, "Cannot read cell parameters", line_cell, token, &
+            & filename(unit), lcell, "expected real values")
+         return
+      end if
       if (debug) print*, latvec(:p_ncp(periodic))
       if (lattice_in_bohr) then
          conv = 1.0_wp
@@ -326,6 +333,8 @@ subroutine read_coord(mol, unit, error)
             &       pi/2, pi/2, latvec(3)*pi/180.0_wp]
       case(3)
          cellpar = [latvec(1:3)*conv, latvec(4:6)*pi/180.0_wp]
+      case default
+         continue
       end select
       call cell_to_dlat(cellpar, lattice)
    end if
@@ -342,6 +351,11 @@ subroutine read_coord(mol, unit, error)
          return
       end if
       read(lattice_string, *, iostat=stat) latvec(:p_nlv(periodic))
+      if (stat /= 0) then
+         call io_error(error, "Cannot read lattice vectors", line_lattice, token, &
+            & filename(unit), llattice, "expected real values")
+         return
+      end if
       if (lattice_in_bohr) then
          conv = 1.0_wp
       else

src/mctc/io/symbols.f90

@@ -124,6 +124,8 @@ elemental subroutine symbol_to_number(number, symbol)
       select case(lcsymbol)
       case("d ", "t ")
          number = 1
+      case default
+         continue
       end select
    end if
 

src/mctc/io/utils.f90

@@ -60,7 +60,7 @@ subroutine getline(unit, line, iostat, iomsg)
    integer, intent(out) :: iostat
 
    !> Error message
-   character(len=:), allocatable, optional :: iomsg
+   character(len=:), allocatable, intent(out), optional :: iomsg
 
    integer, parameter :: bufsize = 512
    character(len=bufsize) :: buffer
@@ -109,7 +109,7 @@ subroutine next_line(unit, line, pos, lnum, iostat, iomsg)
    integer, intent(out) :: iostat
 
    !> Error message
-   character(len=:), allocatable, optional :: iomsg
+   character(len=:), allocatable, intent(out), optional :: iomsg
 
    pos = 0
    call getline(unit, line, iostat, iomsg)
@@ -405,7 +405,9 @@ subroutine read_token_int(line, token, val, iostat, iomsg)
    character(len=512) :: msg
 
    if (token%first > 0 .and. token%last <= len(line)) then
+      val = 0
       read(line(token%first:token%last), *, iostat=iostat, iomsg=msg) val
+      if (iostat /= 0) val = 0
    else
       iostat = 1
       msg = "No input found"
@@ -437,7 +439,9 @@ subroutine read_token_real(line, token, val, iostat, iomsg)
    character(len=512) :: msg
 
    if (token%first > 0 .and. token%last <= len(line)) then
+      val = 0.0_wp
       read(line(token%first:token%last), *, iostat=iostat, iomsg=msg) val
+      if (iostat /= 0) val = 0.0_wp
    else
       iostat = 1
       msg = "No input found"

src/mctc/ncoord/erf.f90

@@ -53,7 +53,7 @@ subroutine new_erf_ncoord(self, mol, kcn, cutoff, rcov, cut, norm_exp)
       !> Molecular structure data
       type(structure_type), intent(in) :: mol
       !> Steepness of counting function
-      real(wp), optional :: kcn
+      real(wp), intent(in), optional :: kcn
       !> Real space cutoff
       real(wp), intent(in), optional :: cutoff
       !> Covalent radii

src/mctc/ncoord/erf/dftd4.f90

@@ -56,7 +56,7 @@ subroutine new_erf_dftd4_ncoord(self, mol, kcn, cutoff, rcov, en, cut, norm_exp)
       !> Molecular structure data
       type(structure_type), intent(in) :: mol
       !> Steepness of counting function
-      real(wp), optional :: kcn
+      real(wp), intent(in), optional :: kcn
       !> Real space cutoff
       real(wp), intent(in), optional :: cutoff
       !> Covalent radii

src/mctc/ncoord/erf/en.f90

@@ -49,7 +49,7 @@ subroutine new_erf_en_ncoord(self, mol, kcn, cutoff, rcov, en, cut, norm_exp)
       !> Molecular structure data
       type(structure_type), intent(in) :: mol
       !> Steepness of counting function
-      real(wp), optional :: kcn
+      real(wp), intent(in), optional :: kcn
       !> Real space cutoff
       real(wp), intent(in), optional :: cutoff
       !> Covalent radii

src/mctc/ncoord/exp.f90

@@ -48,7 +48,7 @@ subroutine new_exp_ncoord(self, mol, kcn, cutoff, rcov, cut)
       !> Molecular structure data
       type(structure_type), intent(in) :: mol
       !> Steepness of counting function
-      real(wp), optional :: kcn
+      real(wp), intent(in), optional :: kcn
       !> Real space cutoff
       real(wp), intent(in), optional :: cutoff
       !> Covalent radii

test/test_math.f90

@@ -15,7 +15,7 @@
 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
+   use mctc_io_math, only : matdet_3x3, matinv_3x3, eigval_3x3, eigvec_3x3
    implicit none
    private
 

test/test_ncoord.f90

@@ -117,10 +117,10 @@ subroutine test_cn_gen(error, mol, ncoord, ref)
       type(error_type), allocatable, intent(out) :: error
 
       !> Molecular structure data
-      type(structure_type) :: mol
+      type(structure_type), intent(in) :: mol
 
       !> Coordination number type
-      class(ncoord_type)   :: ncoord
+      class(ncoord_type), intent(in) :: ncoord
 
       !> Reference CNs
       real(wp), intent(in) :: ref(:)
@@ -149,7 +149,7 @@ subroutine test_numgrad(error, mol, ncoord)
       type(structure_type), intent(inout) :: mol
 
       !> Coordination number type
-      class(ncoord_type)   :: ncoord
+      class(ncoord_type), intent(in) :: ncoord
 
       integer :: iat, ic
       real(wp), allocatable :: cn(:), cnr(:), cnl(:)
@@ -193,7 +193,7 @@ subroutine test_numsigma(error, mol, ncoord)
       type(structure_type), intent(inout) :: mol
 
       !> Coordination number type
-      class(ncoord_type)   :: ncoord
+      class(ncoord_type), intent(in) :: ncoord
 
       integer :: ic, jc
       real(wp) :: eps(3, 3)

test/test_read.f90

@@ -16,7 +16,7 @@ module test_read
    use mctc_env_accuracy, only : wp
    use mctc_env_testing, only : new_unittest, unittest_type, error_type, check
    use mctc_io_filetype, only : get_filetype
-   use mctc_io_read
+   use mctc_io_read, only : read_structure
    use mctc_io_structure, only : structure_type
    use mctc_version, only : get_mctc_feature
    implicit none

test/test_read_aims.f90

@@ -15,8 +15,8 @@
 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
+   use mctc_io_read_aims, only : read_aims
+   use mctc_io_structure, only : structure_type
    implicit none
    private
 

test/test_read_cjson.f90

@@ -14,8 +14,8 @@
 
 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_io_read_cjson, only : read_cjson
+   use mctc_io_structure, only : structure_type
    use mctc_version, only : get_mctc_feature
    implicit none
    private

test/test_read_ctfile.f90

@@ -14,8 +14,8 @@
 
 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
+   use mctc_io_read_ctfile, only : read_molfile, read_sdf
+   use mctc_io_structure, only : structure_type
    implicit none
    private
 

test/test_read_gaussian.f90

@@ -14,8 +14,8 @@
 
 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
+   use mctc_io_read_gaussian, only : read_gaussian_external
+   use mctc_io_structure, only : structure_type
    implicit none
    private
 

test/test_read_genformat.f90

@@ -14,8 +14,8 @@
 
 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
+   use mctc_io_read_genformat, only : read_genformat
+   use mctc_io_structure, only : structure_type
    implicit none
    private
 

test/test_read_json.f90

@@ -14,8 +14,8 @@
 
 module test_read_json
    use mctc_env_testing, only : new_unittest, unittest_type, error_type, check
-   use mctc_io_read_json
-   use mctc_io_structure
+   use mctc_io_read_json, only : read_json
+   use mctc_io_structure, only : structure_type
    use mctc_version, only : get_mctc_feature
    implicit none
    private

test/test_read_pdb.f90

@@ -15,7 +15,7 @@
 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_read_pdb, only : read_pdb
    use mctc_io_structure, only : structure_type
    implicit none
    private

test/test_read_pymatgen.f90

@@ -14,8 +14,8 @@
 
 module test_read_pymatgen
    use mctc_env_testing, only : new_unittest, unittest_type, error_type, check
-   use mctc_io_read_pymatgen
-   use mctc_io_structure
+   use mctc_io_read_pymatgen, only : read_pymatgen
+   use mctc_io_structure, only : structure_type
    use mctc_version, only : get_mctc_feature
    implicit none
    private

test/test_read_qchem.f90

@@ -15,8 +15,8 @@
 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
+   use mctc_io_read_qchem, only : read_qchem
+   use mctc_io_structure, only : structure_type
    implicit none
    private
 

test/test_read_qcschema.f90

@@ -14,8 +14,8 @@
 
 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_io_read_qcschema, only : read_qcschema
+   use mctc_io_structure, only : structure_type
    use mctc_version, only : get_mctc_feature
    implicit none
    private