From 22061950fa7a277a276f619f6206e4e3d18c3df9 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Tue, 10 Feb 2026 13:51:23 +0000 Subject: [PATCH 1/8] Fix interface-implicit-typing --- fortitude.toml | 1 - fruit/fruit.f90 | 2 ++ 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/fortitude.toml b/fortitude.toml index c9645eb..f9d8888 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -1,7 +1,6 @@ [check] exclude = ['.venv'] ignore = [ - 'C002', # interface-implicit-typing 'C003', # implicit-external-procedures 'C061', # missing-intent 'C071', # assumed-size diff --git a/fruit/fruit.f90 b/fruit/fruit.f90 index d240133..b227d43 100644 --- a/fruit/fruit.f90 +++ b/fruit/fruit.f90 @@ -971,6 +971,7 @@ end subroutine fruit_hide_dots_ subroutine run_test_case_named_( tc, tc_name ) interface subroutine tc() + implicit none end subroutine end interface character(*), intent(in) :: tc_name @@ -1015,6 +1016,7 @@ end subroutine run_test_case_named_ subroutine run_test_case_( tc ) interface subroutine tc() + implicit none end subroutine end interface From 70c49e6768c4a48f0ce27c125f75aecb214d4331 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Tue, 10 Feb 2026 13:54:42 +0000 Subject: [PATCH 2/8] Fix deprecated-relational-operator --- fortitude.toml | 1 - fruit/fruit.f90 | 14 +++++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/fortitude.toml b/fortitude.toml index f9d8888..8ce48b2 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -10,6 +10,5 @@ ignore = [ 'C141', # missing-exit-or-cycle-label 'E001', # syntax-error 'MOD011', # old-style-array-literal - 'MOD021', # deprecated-relational-operator 'S061', # unnamed-end-statement ] diff --git a/fruit/fruit.f90 b/fruit/fruit.f90 index b227d43..955a6c0 100644 --- a/fruit/fruit.f90 +++ b/fruit/fruit.f90 @@ -230,7 +230,7 @@ function integer32Equal (number1, number2 ) result (resultValue) resultValue = .false. - if ( number1 .eq. number2 ) then + if ( number1 == number2 ) then resultValue = .true. else resultValue = .false. @@ -243,7 +243,7 @@ function integer64Equal (number1, number2 ) result (resultValue) resultValue = .false. - if ( number1 .eq. number2 ) then + if ( number1 == number2 ) then resultValue = .true. else resultValue = .false. @@ -256,7 +256,7 @@ function stringEqual (str1, str2 ) result (resultValue) resultValue = .false. - if ( str1 .eq. str2 ) then + if ( str1 == str2 ) then resultValue = .true. end if end function stringEqual @@ -997,7 +997,7 @@ subroutine tc() !$OMP BARRIER - if ( initial_failed_assert_count .eq. failed_assert_count ) then + if ( initial_failed_assert_count == failed_assert_count ) then ! If no additional assertions failed during the run of this test case ! then the test case was successful successful_case_count = successful_case_count+1 @@ -1102,12 +1102,12 @@ end subroutine add_fail_unit_ subroutine obsolete_isAllSuccessful_(result) logical, intent(out) :: result call obsolete_ ('subroutine isAllSuccessful is changed to function is_all_successful.') - result = (failed_assert_count .eq. 0 ) + result = (failed_assert_count == 0 ) end subroutine obsolete_isAllSuccessful_ subroutine is_all_successful(result) logical, intent(out) :: result - result= (failed_assert_count .eq. 0 ) + result= (failed_assert_count == 0 ) end subroutine is_all_successful ! Private, helper routine to wrap lines of success/failed marks @@ -1119,7 +1119,7 @@ subroutine output_mark_( chr ) !$omp critical (FRUIT_OMP_ADD_OUTPUT_MARK) linechar_count = linechar_count + 1 - if ( linechar_count .lt. MAX_MARKS_PER_LINE ) then + if ( linechar_count < MAX_MARKS_PER_LINE ) then write(stdout,"(A1)",ADVANCE='NO') chr else write(stdout,"(A1)",ADVANCE='YES') chr From 98f98184fd38d6d84f04397c154e42aaa978d596 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Tue, 10 Feb 2026 14:04:29 +0000 Subject: [PATCH 3/8] Fix old-style-array-literal --- fortitude.toml | 1 - shum_fieldsfile_class/src/f_shum_file.f90 | 16 ++++++++-------- shum_number_tools/src/f_shum_is_denormal.F90 | 18 +++++++++--------- shum_number_tools/src/f_shum_is_inf.F90 | 18 +++++++++--------- shum_number_tools/src/f_shum_is_nan.F90 | 18 +++++++++--------- 5 files changed, 35 insertions(+), 36 deletions(-) diff --git a/fortitude.toml b/fortitude.toml index 8ce48b2..1c457f6 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -9,6 +9,5 @@ ignore = [ 'C121', # use-all 'C141', # missing-exit-or-cycle-label 'E001', # syntax-error - 'MOD011', # old-style-array-literal 'S061', # unnamed-end-statement ] diff --git a/shum_fieldsfile_class/src/f_shum_file.f90 b/shum_fieldsfile_class/src/f_shum_file.f90 index 12f6e05..ccd4dc6 100644 --- a/shum_fieldsfile_class/src/f_shum_file.f90 +++ b/shum_fieldsfile_class/src/f_shum_file.f90 @@ -929,7 +929,7 @@ FUNCTION read_field(self, field_number) RESULT(STATUS) RETURN END IF ALLOCATE(tmp_field_data_r64(cols, rows)) - tmp_field_data_r64 = RESHAPE(field_data_r64, (/cols, rows/)) + tmp_field_data_r64 = RESHAPE(field_data_r64, [cols, rows]) STATUS = self%fields(field_number)%set_data(tmp_field_data_r64) IF (STATUS%icode /= shumlib_success) THEN WRITE(STATUS%message, '(A,I0)') 'Error setting data for field ', & @@ -948,7 +948,7 @@ FUNCTION read_field(self, field_number) RESULT(STATUS) RETURN END IF ALLOCATE(tmp_field_data_i64(cols, rows)) - tmp_field_data_i64 = RESHAPE(field_data_i64, (/cols, rows/)) + tmp_field_data_i64 = RESHAPE(field_data_i64, [cols, rows]) STATUS = self%fields(field_number)%set_data(tmp_field_data_i64) IF (STATUS%icode /= shumlib_success) THEN WRITE(STATUS%message, '(A,I0)') 'Error setting data for field ', & @@ -1002,7 +1002,7 @@ FUNCTION read_field(self, field_number) RESULT(STATUS) ! Promote to 64-bit ALLOCATE(tmp_field_data_r64(cols, rows)) ALLOCATE(tmp_field_data_r32(cols, rows)) - tmp_field_data_r32 = RESHAPE(field_data_r32, (/cols, rows/)) + tmp_field_data_r32 = RESHAPE(field_data_r32, [cols, rows]) DO j_value = 1, rows DO i_value = 1, cols tmp_field_data_r64(i_value,j_value) = tmp_field_data_r32( & @@ -1030,7 +1030,7 @@ FUNCTION read_field(self, field_number) RESULT(STATUS) ! Promote to 64-bit ALLOCATE(tmp_field_data_i64(cols, rows)) ALLOCATE(tmp_field_data_i32(cols, rows)) - tmp_field_data_i32 = RESHAPE(field_data_i32, (/cols, rows/)) + tmp_field_data_i32 = RESHAPE(field_data_i32, [cols, rows]) DO j_value = 1, rows DO i_value = 1, cols tmp_field_data_i64(i_value, j_value) = tmp_field_data_i32( & @@ -1693,7 +1693,7 @@ FUNCTION write_field(self, field_number) RESULT(STATUS) RETURN END IF ALLOCATE(field_data_r64(rows*cols)) - field_data_r64 = RESHAPE(tmp_field_data_r64, (/cols * rows/)) + field_data_r64 = RESHAPE(tmp_field_data_r64, [cols * rows]) STATUS%icode = f_shum_write_field_data(self%file_identifier, & lookup, & @@ -1713,7 +1713,7 @@ FUNCTION write_field(self, field_number) RESULT(STATUS) RETURN END IF ALLOCATE(field_data_i64(rows*cols)) - field_data_i64 = RESHAPE(tmp_field_data_i64, (/rows * cols/)) + field_data_i64 = RESHAPE(tmp_field_data_i64, [rows * cols]) STATUS%icode = f_shum_write_field_data(self%file_identifier, & lookup, & @@ -1776,7 +1776,7 @@ FUNCTION write_field(self, field_number) RESULT(STATUS) END DO END DO - field_data_r32 = RESHAPE(tmp_field_data_r32, (/rows*cols/)) + field_data_r32 = RESHAPE(tmp_field_data_r32, [rows*cols]) STATUS%icode = f_shum_write_field_data(self%file_identifier, & lookup, & field_data_r32, & @@ -1803,7 +1803,7 @@ FUNCTION write_field(self, field_number) RESULT(STATUS) i_value,j_value), INT32) END DO END DO - field_data_i32 = RESHAPE(tmp_field_data_i32, (/rows*cols/)) + field_data_i32 = RESHAPE(tmp_field_data_i32, [rows*cols]) STATUS%icode = f_shum_write_field_data(self%file_identifier, & lookup, & field_data_i32, & diff --git a/shum_number_tools/src/f_shum_is_denormal.F90 b/shum_number_tools/src/f_shum_is_denormal.F90 index 66a5282..ce0cef1 100644 --- a/shum_number_tools/src/f_shum_is_denormal.F90 +++ b/shum_number_tools/src/f_shum_is_denormal.F90 @@ -217,7 +217,7 @@ LOGICAL FUNCTION f_shum_has_denormal32(x) END FUNCTION f_shum_has_denormal32 ! To use for multi-dimensional arrays you can call f_shum_has_denormal with the -! array reshaped, e.g. f_shum_has_denormal(RESHAPE(x, (/SIZE(x)/))) +! array reshaped, e.g. f_shum_has_denormal(RESHAPE(x, [SIZE(x)])) !*************************************************************************** ! 2D Array 64-bit version @@ -232,7 +232,7 @@ LOGICAL FUNCTION f_shum_has_denormal64_2d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal64_2d = f_shum_has_denormal64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal64_2d = f_shum_has_denormal64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal64_2d @@ -249,7 +249,7 @@ LOGICAL FUNCTION f_shum_has_denormal32_2d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal32_2d = f_shum_has_denormal32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal32_2d = f_shum_has_denormal32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal32_2d @@ -266,7 +266,7 @@ LOGICAL FUNCTION f_shum_has_denormal64_3d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal64_3d = f_shum_has_denormal64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal64_3d = f_shum_has_denormal64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal64_3d @@ -283,7 +283,7 @@ LOGICAL FUNCTION f_shum_has_denormal32_3d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal32_3d = f_shum_has_denormal32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal32_3d = f_shum_has_denormal32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal32_3d @@ -300,7 +300,7 @@ LOGICAL FUNCTION f_shum_has_denormal64_4d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal64_4d = f_shum_has_denormal64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal64_4d = f_shum_has_denormal64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal64_4d @@ -317,7 +317,7 @@ LOGICAL FUNCTION f_shum_has_denormal32_4d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal32_4d = f_shum_has_denormal32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal32_4d = f_shum_has_denormal32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal32_4d @@ -334,7 +334,7 @@ LOGICAL FUNCTION f_shum_has_denormal64_5d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal64_5d = f_shum_has_denormal64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal64_5d = f_shum_has_denormal64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal64_5d @@ -351,7 +351,7 @@ LOGICAL FUNCTION f_shum_has_denormal32_5d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_denormal32_5d = f_shum_has_denormal32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_denormal32_5d = f_shum_has_denormal32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_denormal32_5d diff --git a/shum_number_tools/src/f_shum_is_inf.F90 b/shum_number_tools/src/f_shum_is_inf.F90 index 8f6c787..afbcac6 100644 --- a/shum_number_tools/src/f_shum_is_inf.F90 +++ b/shum_number_tools/src/f_shum_is_inf.F90 @@ -188,7 +188,7 @@ LOGICAL FUNCTION f_shum_has_inf32(x) END FUNCTION f_shum_has_inf32 ! To use for multi-dimensional arrays you can call f_shum_has_inf with the array -! reshaped, e.g. f_shum_has_inf(RESHAPE(x, (/SIZE(x)/))) +! reshaped, e.g. f_shum_has_inf(RESHAPE(x, [SIZE(x)])) !*************************************************************************** ! 2D Array 64-bit version @@ -203,7 +203,7 @@ LOGICAL FUNCTION f_shum_has_inf64_2d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf64_2d = f_shum_has_inf64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf64_2d = f_shum_has_inf64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf64_2d @@ -220,7 +220,7 @@ LOGICAL FUNCTION f_shum_has_inf32_2d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf32_2d = f_shum_has_inf32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf32_2d = f_shum_has_inf32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf32_2d @@ -237,7 +237,7 @@ LOGICAL FUNCTION f_shum_has_inf64_3d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf64_3d = f_shum_has_inf64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf64_3d = f_shum_has_inf64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf64_3d @@ -254,7 +254,7 @@ LOGICAL FUNCTION f_shum_has_inf32_3d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf32_3d = f_shum_has_inf32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf32_3d = f_shum_has_inf32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf32_3d @@ -271,7 +271,7 @@ LOGICAL FUNCTION f_shum_has_inf64_4d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf64_4d = f_shum_has_inf64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf64_4d = f_shum_has_inf64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf64_4d @@ -288,7 +288,7 @@ LOGICAL FUNCTION f_shum_has_inf32_4d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf32_4d = f_shum_has_inf32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf32_4d = f_shum_has_inf32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf32_4d @@ -305,7 +305,7 @@ LOGICAL FUNCTION f_shum_has_inf64_5d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf64_5d = f_shum_has_inf64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf64_5d = f_shum_has_inf64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf64_5d @@ -322,7 +322,7 @@ LOGICAL FUNCTION f_shum_has_inf32_5d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_inf32_5d = f_shum_has_inf32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_inf32_5d = f_shum_has_inf32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_inf32_5d diff --git a/shum_number_tools/src/f_shum_is_nan.F90 b/shum_number_tools/src/f_shum_is_nan.F90 index 21d98f7..55afa43 100644 --- a/shum_number_tools/src/f_shum_is_nan.F90 +++ b/shum_number_tools/src/f_shum_is_nan.F90 @@ -228,7 +228,7 @@ LOGICAL FUNCTION f_shum_has_nan32(x) END FUNCTION f_shum_has_nan32 ! To use for multi-dimensional arrays you can call f_shum_has_nan with the array -! reshaped, e.g. f_shum_has_nan(RESHAPE(x, (/SIZE(x)/))) +! reshaped, e.g. f_shum_has_nan(RESHAPE(x, [SIZE(x)])) !*************************************************************************** ! 2D Array 64-bit version @@ -243,7 +243,7 @@ LOGICAL FUNCTION f_shum_has_nan64_2d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan64_2d = f_shum_has_nan64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan64_2d = f_shum_has_nan64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan64_2d @@ -260,7 +260,7 @@ LOGICAL FUNCTION f_shum_has_nan32_2d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan32_2d = f_shum_has_nan32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan32_2d = f_shum_has_nan32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan32_2d @@ -277,7 +277,7 @@ LOGICAL FUNCTION f_shum_has_nan64_3d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan64_3d = f_shum_has_nan64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan64_3d = f_shum_has_nan64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan64_3d @@ -294,7 +294,7 @@ LOGICAL FUNCTION f_shum_has_nan32_3d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan32_3d = f_shum_has_nan32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan32_3d = f_shum_has_nan32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan32_3d @@ -311,7 +311,7 @@ LOGICAL FUNCTION f_shum_has_nan64_4d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan64_4d = f_shum_has_nan64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan64_4d = f_shum_has_nan64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan64_4d @@ -328,7 +328,7 @@ LOGICAL FUNCTION f_shum_has_nan32_4d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan32_4d = f_shum_has_nan32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan32_4d = f_shum_has_nan32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan32_4d @@ -345,7 +345,7 @@ LOGICAL FUNCTION f_shum_has_nan64_5d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan64_5d = f_shum_has_nan64(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan64_5d = f_shum_has_nan64(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan64_5d @@ -362,7 +362,7 @@ LOGICAL FUNCTION f_shum_has_nan32_5d(x) ! End of header ! Reshape array and pass through 1d array version -f_shum_has_nan32_5d = f_shum_has_nan32(RESHAPE(x, (/SIZE(x)/))) +f_shum_has_nan32_5d = f_shum_has_nan32(RESHAPE(x, [SIZE(x)])) END FUNCTION f_shum_has_nan32_5d From 77250ccdd9124f797cffa180a8850d957bc4d879 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Tue, 10 Feb 2026 16:23:09 +0000 Subject: [PATCH 4/8] Fix unnamed-end-statement --- fortitude.toml | 1 - fruit/fruit.f90 | 4 ++-- shum_fieldsfile/src/f_shum_fieldsfile.f90 | 2 +- shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 | 2 +- .../test/fruit_test_shum_fieldsfile_class.f90 | 2 +- .../test/fruit_test_shum_number_tools.F90 | 12 ++++++------ shum_wgdos_packing/src/f_shum_wgdos_packing.f90 | 2 +- 7 files changed, 12 insertions(+), 13 deletions(-) diff --git a/fortitude.toml b/fortitude.toml index 1c457f6..85c2a90 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -9,5 +9,4 @@ ignore = [ 'C121', # use-all 'C141', # missing-exit-or-cycle-label 'E001', # syntax-error - 'S061', # unnamed-end-statement ] diff --git a/fruit/fruit.f90 b/fruit/fruit.f90 index 955a6c0..66fef6f 100644 --- a/fruit/fruit.f90 +++ b/fruit/fruit.f90 @@ -972,7 +972,7 @@ subroutine run_test_case_named_( tc, tc_name ) interface subroutine tc() implicit none - end subroutine + end subroutine tc end interface character(*), intent(in) :: tc_name @@ -1017,7 +1017,7 @@ subroutine run_test_case_( tc ) interface subroutine tc() implicit none - end subroutine + end subroutine tc end interface call run_test_case_named_( tc, '_unnamed_' ) diff --git a/shum_fieldsfile/src/f_shum_fieldsfile.f90 b/shum_fieldsfile/src/f_shum_fieldsfile.f90 index 790a46d..cb518ff 100644 --- a/shum_fieldsfile/src/f_shum_fieldsfile.f90 +++ b/shum_fieldsfile/src/f_shum_fieldsfile.f90 @@ -276,7 +276,7 @@ FUNCTION unique_id_to_ff(id) RESULT(ff) ! returning the last element in the list NULLIFY(ff) -END FUNCTION +END FUNCTION unique_id_to_ff !------------------------------------------------------------------------------! diff --git a/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 b/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 index 8cf0488..c3ee306 100644 --- a/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 +++ b/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 @@ -38,7 +38,7 @@ SUBROUTINE c_exit(status) BIND(c,NAME="exit") IMPORT :: C_INT IMPLICIT NONE INTEGER(KIND=C_INT), VALUE, INTENT(IN) :: status -END SUBROUTINE +END SUBROUTINE c_exit END INTERFACE !------------------------------------------------------------------------------! diff --git a/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 b/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 index 4f27a63..26af5d0 100644 --- a/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 +++ b/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 @@ -39,7 +39,7 @@ SUBROUTINE c_exit(status) BIND(c,NAME="exit") IMPORT :: C_INT IMPLICIT NONE INTEGER(KIND=C_INT), VALUE, INTENT(IN) :: status -END SUBROUTINE +END SUBROUTINE c_exit END INTERFACE !------------------------------------------------------------------------------! diff --git a/shum_number_tools/test/fruit_test_shum_number_tools.F90 b/shum_number_tools/test/fruit_test_shum_number_tools.F90 index eb0b0bb..c28a0ad 100644 --- a/shum_number_tools/test/fruit_test_shum_number_tools.F90 +++ b/shum_number_tools/test/fruit_test_shum_number_tools.F90 @@ -40,7 +40,7 @@ FUNCTION c_test_generate_finf() BIND(c,NAME="c_test_generate_finf") IMPORT :: C_FLOAT IMPLICIT NONE REAL(KIND=C_FLOAT) :: c_test_generate_finf - END FUNCTION + end function c_test_generate_finf END INTERFACE !------------------------------------------------------------------------------! @@ -50,7 +50,7 @@ FUNCTION c_test_generate_dinf() BIND(c,NAME="c_test_generate_dinf") IMPORT :: C_DOUBLE IMPLICIT NONE REAL(KIND=C_DOUBLE) :: c_test_generate_dinf - END FUNCTION + end function c_test_generate_dinf END INTERFACE !------------------------------------------------------------------------------! @@ -60,7 +60,7 @@ FUNCTION c_test_generate_fnan() BIND(c,NAME="c_test_generate_fnan") IMPORT :: C_FLOAT IMPLICIT NONE REAL(KIND=C_FLOAT) :: c_test_generate_fnan - END FUNCTION + end function c_test_generate_fnan END INTERFACE !------------------------------------------------------------------------------! @@ -70,7 +70,7 @@ FUNCTION c_test_generate_dnan() BIND(c,NAME="c_test_generate_dnan") IMPORT :: C_DOUBLE IMPLICIT NONE REAL(KIND=C_DOUBLE) :: c_test_generate_dnan - END FUNCTION + end function c_test_generate_dnan END INTERFACE !------------------------------------------------------------------------------! @@ -81,7 +81,7 @@ SUBROUTINE c_test_generate_fdenormal(denormal_float) & IMPORT :: C_FLOAT IMPLICIT NONE REAL(KIND=C_FLOAT) :: denormal_float - END SUBROUTINE + end subroutine c_test_generate_fdenormal END INTERFACE !------------------------------------------------------------------------------! @@ -92,7 +92,7 @@ SUBROUTINE c_test_generate_ddenormal(denormal_double) & IMPORT :: C_DOUBLE IMPLICIT NONE REAL(KIND=C_DOUBLE) :: denormal_double - END SUBROUTINE + end subroutine c_test_generate_ddenormal END INTERFACE !------------------------------------------------------------------------------! diff --git a/shum_wgdos_packing/src/f_shum_wgdos_packing.f90 b/shum_wgdos_packing/src/f_shum_wgdos_packing.f90 index c0756d1..e50fc75 100644 --- a/shum_wgdos_packing/src/f_shum_wgdos_packing.f90 +++ b/shum_wgdos_packing/src/f_shum_wgdos_packing.f90 @@ -147,7 +147,7 @@ FUNCTION f_shum_read_wgdos_header_arg64( & cols = INT(cols_32, KIND=int64) rows = INT(rows_32, KIND=int64) -END FUNCTION +END FUNCTION f_shum_read_wgdos_header_arg64 !------------------------------------------------------------------------------! From ef778e358bbaf07b32eb19dc68f595132017c162 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Tue, 10 Feb 2026 18:22:48 +0000 Subject: [PATCH 5/8] Fix use-all --- fortitude.toml | 7 ++++-- .../test/fruit_test_shum_byteswap.f90 | 24 +++++++++++++++++-- .../test/fruit_test_shum_fieldsfile.f90 | 3 ++- .../test/fruit_test_shum_fieldsfile_class.f90 | 2 +- ...ruit_test_shum_horizontal_field_interp.f90 | 2 +- shum_kinds/test/fruit_test_shum_kinds.f90 | 2 +- .../test/fruit_test_shum_latlon_eq_grids.f90 | 2 +- .../test/fruit_test_shum_number_tools.F90 | 2 +- .../test/fruit_test_shum_spiral_search.f90 | 2 +- .../test/fruit_test_shum_string_conv.f90 | 2 +- .../test/fruit_test_shum_thread_utils.f90 | 2 +- .../test/fruit_test_shum_wgdos_packing.f90 | 2 +- 12 files changed, 38 insertions(+), 14 deletions(-) diff --git a/fortitude.toml b/fortitude.toml index 85c2a90..9284007 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -1,12 +1,15 @@ [check] -exclude = ['.venv'] +exclude = [ + '.venv', + 'fruit/fruit.f90', + 'fruit/fruit_mpi.f90', +] ignore = [ 'C003', # implicit-external-procedures 'C061', # missing-intent 'C071', # assumed-size 'C072', # assumed-size-character-intent 'C081', # initialisation-in-declaration - 'C121', # use-all 'C141', # missing-exit-or-cycle-label 'E001', # syntax-error ] diff --git a/shum_byteswap/test/fruit_test_shum_byteswap.f90 b/shum_byteswap/test/fruit_test_shum_byteswap.f90 index 770c96e..439f9cf 100644 --- a/shum_byteswap/test/fruit_test_shum_byteswap.f90 +++ b/shum_byteswap/test/fruit_test_shum_byteswap.f90 @@ -21,10 +21,30 @@ !******************************************************************************* MODULE fruit_test_shum_byteswap_mod -USE fruit +USE fruit, ONLY: assert_equals, assert_true, run_test_case, set_case_name USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_BOOL -USE f_shum_ztables_mod +USE f_shum_ztables_mod, ONLY: & + z0000000000000040, z0000000000000840, z0000000000001040, & + z0000000000001440, z0000000000001840, z0000000000001C40, & + z0000000000002040, z0000000000002240, z0000000000002440, & + z000000000000F03F, z0000000001000000, z0000000002000000, & + z0000000003000000, z0000000004000000, z0000000005000000, & + z0000000006000000, z0000000007000000, z0000000008000000, & + z0000000009000000, z000000000A000000, z00000040, & + z0000004000000000, z00000041, z0000084000000000, & + z0000104000000000, z00001041, z0000144000000000, & + z0000184000000000, z00001C4000000000, z0000204000000000, & + z00002041, z0000224000000000, z0000244000000000, & + z00004040, z0000803F, z00008040, & + z0000A040, z0000C040, z0000E040, & + z0000F03F00000000, z01000000, z0100000000000000, & + z02000000, z0200000000000000, z03000000, & + z0300000000000000, z04000000, z0400000000000000, & + z05000000, z0500000000000000, z06000000, & + z0600000000000000, z07000000, z0700000000000000, & + z08000000, z0800000000000000, z09000000, & + z0900000000000000, z0A000000, z0A00000000000000 IMPLICIT NONE PRIVATE diff --git a/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 b/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 index c3ee306..1091068 100644 --- a/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 +++ b/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 @@ -21,7 +21,8 @@ !******************************************************************************* MODULE fruit_test_shum_fieldsfile_mod -USE fruit +USE fruit, ONLY: assert_equals, assert_false, assert_true, get_failed_count, & + run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_INT, C_BOOL diff --git a/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 b/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 index 26af5d0..70dd892 100644 --- a/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 +++ b/shum_fieldsfile_class/test/fruit_test_shum_fieldsfile_class.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_fieldsfile_class_mod -USE fruit +USE fruit, ONLY: assert_equals, get_failed_count, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_INT, C_BOOL diff --git a/shum_horizontal_field_interp/test/fruit_test_shum_horizontal_field_interp.f90 b/shum_horizontal_field_interp/test/fruit_test_shum_horizontal_field_interp.f90 index 533ad70..0e3c9fd 100644 --- a/shum_horizontal_field_interp/test/fruit_test_shum_horizontal_field_interp.f90 +++ b/shum_horizontal_field_interp/test/fruit_test_shum_horizontal_field_interp.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_horizontal_field_interp_mod -USE fruit +USE fruit, ONLY: assert_equals, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_BOOL USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: OUTPUT_UNIT diff --git a/shum_kinds/test/fruit_test_shum_kinds.f90 b/shum_kinds/test/fruit_test_shum_kinds.f90 index af1bd2b..0790928 100644 --- a/shum_kinds/test/fruit_test_shum_kinds.f90 +++ b/shum_kinds/test/fruit_test_shum_kinds.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_kinds_mod -USE fruit +USE fruit, ONLY: assert_equals, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_INT, C_BOOL diff --git a/shum_latlon_eq_grids/test/fruit_test_shum_latlon_eq_grids.f90 b/shum_latlon_eq_grids/test/fruit_test_shum_latlon_eq_grids.f90 index 97b214f..b9f88b2 100644 --- a/shum_latlon_eq_grids/test/fruit_test_shum_latlon_eq_grids.f90 +++ b/shum_latlon_eq_grids/test/fruit_test_shum_latlon_eq_grids.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_latlon_eq_grids_mod -USE fruit +USE fruit, ONLY: assert_equals, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE IMPLICIT NONE diff --git a/shum_number_tools/test/fruit_test_shum_number_tools.F90 b/shum_number_tools/test/fruit_test_shum_number_tools.F90 index c28a0ad..cdffaad 100644 --- a/shum_number_tools/test/fruit_test_shum_number_tools.F90 +++ b/shum_number_tools/test/fruit_test_shum_number_tools.F90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_number_tools_mod -USE fruit +USE fruit, ONLY: assert_false, assert_not_equals, assert_true, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_INT, C_BOOL diff --git a/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 b/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 index 0333c94..5b6688d 100644 --- a/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 +++ b/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_spiral_search_mod -USE fruit +USE fruit, ONLY: assert_equals, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_BOOL diff --git a/shum_string_conv/test/fruit_test_shum_string_conv.f90 b/shum_string_conv/test/fruit_test_shum_string_conv.f90 index fe0ef5a..efe9ebf 100644 --- a/shum_string_conv/test/fruit_test_shum_string_conv.f90 +++ b/shum_string_conv/test/fruit_test_shum_string_conv.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_string_conv_mod -USE fruit +USE fruit, ONLY: assert_equals, run_test_case, set_case_name USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_CHAR, C_NULL_CHAR, C_PTR, C_LOC diff --git a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 index 6b08d02..e0b9d9c 100644 --- a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 +++ b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_thread_utils_mod -USE fruit +USE fruit, ONLY: assert_true, run_test_case, set_case_name USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_INT64_T, C_INT32_T, C_FLOAT, & C_DOUBLE, C_BOOL !$ USE omp_lib diff --git a/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 b/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 index 6900b53..396b9c9 100644 --- a/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 +++ b/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 @@ -21,7 +21,7 @@ !******************************************************************************* MODULE fruit_test_shum_wgdos_packing_mod -USE fruit +USE fruit, ONLY: assert_equals, run_test_case USE, INTRINSIC :: ISO_C_BINDING, ONLY: & C_INT64_T, C_INT32_T, C_FLOAT, C_DOUBLE, C_LOC, C_F_POINTER From b8da5d3db64729a9a7455cc62b636e6da8dc6cac Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Tue, 10 Feb 2026 20:30:16 +0000 Subject: [PATCH 6/8] Fix initialisation-in-declaration --- fortitude.toml | 1 - .../test/fruit_test_shum_fieldsfile.f90 | 12 ++++++-- shum_fieldsfile_class/src/f_shum_file.f90 | 4 ++- .../test/fruit_test_shum_spiral_search.f90 | 28 ++++++++++++------- 4 files changed, 30 insertions(+), 15 deletions(-) diff --git a/fortitude.toml b/fortitude.toml index 9284007..ec50b53 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -9,7 +9,6 @@ ignore = [ 'C061', # missing-intent 'C071', # assumed-size 'C072', # assumed-size-character-intent - 'C081', # initialisation-in-declaration 'C141', # missing-exit-or-cycle-label 'E001', # syntax-error ] diff --git a/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 b/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 index 1091068..eac5cd6 100644 --- a/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 +++ b/shum_fieldsfile/test/fruit_test_shum_fieldsfile.f90 @@ -157,7 +157,7 @@ SUBROUTINE test_end_to_end_direct_write_file IMPLICIT NONE INTEGER(KIND=int64) :: status -CHARACTER(LEN=500) :: message = "" +CHARACTER(LEN=500) :: message INTEGER(KIND=int64) :: ff_id CHARACTER(LEN=*), PARAMETER :: tempfile="fruit_test_fieldsfile_direct.ff" @@ -227,6 +227,8 @@ SUBROUTINE test_end_to_end_direct_write_file LOGICAL(KIND=bool) :: check +message = "" + ! Get the number of failed tests prior to this test starting CALL get_failed_count(failures_at_entry) @@ -879,7 +881,7 @@ SUBROUTINE test_end_to_end_sequential_write_file IMPLICIT NONE INTEGER(KIND=int64) :: status -CHARACTER(LEN=500) :: message = "" +CHARACTER(LEN=500) :: message INTEGER(KIND=int64) :: ff_id CHARACTER(LEN=*), PARAMETER :: tempfile="fruit_test_fieldsfile_sequential.ff" @@ -949,6 +951,8 @@ SUBROUTINE test_end_to_end_sequential_write_file LOGICAL(KIND=bool) :: check +message = "" + ! Get the number of failed tests prior to this test starting CALL get_failed_count(failures_at_entry) @@ -1555,7 +1559,7 @@ SUBROUTINE test_stashmaster_read IMPLICIT NONE INTEGER(KIND=int64) :: status -CHARACTER(LEN=500) :: message = "" +CHARACTER(LEN=500) :: message CHARACTER(LEN=1) :: newline TYPE(shum_STASHmaster), ALLOCATABLE :: STASHmaster(:) @@ -1570,6 +1574,8 @@ SUBROUTINE test_stashmaster_read INTEGER(KIND=int64) :: packing_codes(10) LOGICAL(KIND=bool) :: check +message = "" + ! Get the number of failed tests prior to this test starting CALL get_failed_count(failures_at_entry) diff --git a/shum_fieldsfile_class/src/f_shum_file.f90 b/shum_fieldsfile_class/src/f_shum_file.f90 index ccd4dc6..e2d22a1 100644 --- a/shum_fieldsfile_class/src/f_shum_file.f90 +++ b/shum_fieldsfile_class/src/f_shum_file.f90 @@ -231,11 +231,13 @@ FUNCTION read_header(self) RESULT(STATUS) INTEGER(KIND=INT64), PARAMETER :: fieldsfile_type = 3 INTEGER(KIND=INT64), PARAMETER :: ancil_type = 4 -LOGICAL :: is_variable_resolution = .FALSE. +LOGICAL :: is_variable_resolution LOGICAL :: grid_supported TYPE(shum_ff_status_type) :: STATUS ! Return status object +is_variable_resolution = .FALSE. + ! Read in compulsory headers STATUS%icode = f_shum_read_fixed_length_header( & self%file_identifier, & diff --git a/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 b/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 index 5b6688d..90b340e 100644 --- a/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 +++ b/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 @@ -173,13 +173,13 @@ SUBROUTINE test_spiral6_search_arg64 INTEGER(KIND=int64) :: index_unres(no_point_unres) INTEGER(KIND=int64) :: indices(no_point_unres) -LOGICAL(KIND=bool) :: is_land_field = .TRUE. -LOGICAL(KIND=bool) :: constrained = .FALSE. -LOGICAL(KIND=bool) :: cyclic_domain = .FALSE. +LOGICAL(KIND=bool) :: is_land_field +LOGICAL(KIND=bool) :: constrained +LOGICAL(KIND=bool) :: cyclic_domain -REAL(KIND=real64) :: constrained_max_dist = 200000.0 +REAL(KIND=real64), PARAMETER :: constrained_max_dist = 200000.0 REAL(KIND=real64) :: planet_radius -REAL(KIND=real64) :: dist_step = 3.0 +REAL(KIND=real64), PARAMETER :: dist_step = 3.0 INTEGER(KIND=int64) :: result_land(no_point_unres) INTEGER(KIND=int64) :: result_land_con(no_point_unres) @@ -190,6 +190,10 @@ SUBROUTINE test_spiral6_search_arg64 CHARACTER(LEN=400) :: message CHARACTER(LEN=200) :: case_info +is_land_field = .TRUE. +constrained = .FALSE. +cyclic_domain = .FALSE. + ! Retrieve the set of data points to be tested CALL sample_6x6_data(lats, lons, lsm, unres_mask, index_unres, planet_radius ) @@ -281,13 +285,13 @@ SUBROUTINE test_spiral6_search_arg32 INTEGER(KIND=int32) :: index_unres(no_point_unres) INTEGER(KIND=int32) :: indices(no_point_unres) -LOGICAL(KIND=bool) :: is_land_field = .TRUE. -LOGICAL(KIND=bool) :: constrained = .FALSE. -LOGICAL(KIND=bool) :: cyclic_domain = .FALSE. +LOGICAL(KIND=bool) :: is_land_field +LOGICAL(KIND=bool) :: constrained +LOGICAL(KIND=bool) :: cyclic_domain REAL(KIND=real32) :: planet_radius -REAL(KIND=real32) :: constrained_max_dist = 200000.0 -REAL(KIND=real32) :: dist_step = 3.0 +REAL(KIND=real32), PARAMETER :: constrained_max_dist = 200000.0 +REAL(KIND=real32), PARAMETER :: dist_step = 3.0 INTEGER(KIND=int32) :: result_land(no_point_unres) INTEGER(KIND=int32) :: result_land_con(no_point_unres) @@ -298,6 +302,10 @@ SUBROUTINE test_spiral6_search_arg32 CHARACTER(LEN=400) :: message CHARACTER(LEN=200) :: case_info +is_land_field = .TRUE. +constrained = .FALSE. +cyclic_domain = .FALSE. + ! Retrieve the set of data points to be tested - should find 32bit version CALL sample_6x6_data(lats, lons, lsm, unres_mask, index_unres, & planet_radius ) From 59ed1e820cea3896db45cf8ecce0e66f94fda0e3 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Wed, 11 Feb 2026 11:26:14 +0000 Subject: [PATCH 7/8] Fix missing-intent --- fortitude.toml | 2 - shum_fieldsfile/src/f_shum_fieldsfile.f90 | 14 ++--- shum_fieldsfile_class/src/f_shum_field.f90 | 47 ++++++++------- shum_fieldsfile_class/src/f_shum_file.f90 | 60 ++++++++++--------- .../src/f_shum_latlon_eq_grids.f90 | 28 ++++----- .../test/fruit_test_shum_number_tools.F90 | 4 +- .../test/fruit_test_shum_spiral_search.f90 | 2 +- shum_string_conv/src/f_shum_string_conv.f90 | 8 ++- .../test/fruit_test_shum_thread_utils.f90 | 8 +-- .../test/fruit_test_shum_wgdos_packing.f90 | 6 +- 10 files changed, 91 insertions(+), 88 deletions(-) diff --git a/fortitude.toml b/fortitude.toml index ec50b53..eb7272a 100644 --- a/fortitude.toml +++ b/fortitude.toml @@ -6,9 +6,7 @@ exclude = [ ] ignore = [ 'C003', # implicit-external-procedures - 'C061', # missing-intent 'C071', # assumed-size 'C072', # assumed-size-character-intent - 'C141', # missing-exit-or-cycle-label 'E001', # syntax-error ] diff --git a/shum_fieldsfile/src/f_shum_fieldsfile.f90 b/shum_fieldsfile/src/f_shum_fieldsfile.f90 index cb518ff..a25d3e7 100644 --- a/shum_fieldsfile/src/f_shum_fieldsfile.f90 +++ b/shum_fieldsfile/src/f_shum_fieldsfile.f90 @@ -1989,8 +1989,8 @@ END FUNCTION f_shum_write_fixed_length_header FUNCTION commit_fixed_length_header(ff, message) RESULT(STATUS) IMPLICIT NONE -TYPE(ff_type) :: ff -CHARACTER(LEN=*) :: message +TYPE(ff_type), INTENT(IN OUT) :: ff +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=INT64) :: STATUS INTEGER(KIND=INT64), ALLOCATABLE :: swap_header(:) @@ -2044,7 +2044,7 @@ END FUNCTION commit_fixed_length_header FUNCTION get_next_free_position(ff) RESULT(POSITION) IMPLICIT NONE -TYPE(ff_type) :: ff +TYPE(ff_type), INTENT(IN) :: ff INTEGER(KIND=INT64) :: POSITION POSITION = f_shum_fixed_length_header_len + 1 @@ -2133,8 +2133,8 @@ END FUNCTION get_next_free_position FUNCTION get_next_populated_position(ff, start) RESULT(POSITION) IMPLICIT NONE -TYPE(ff_type) :: ff -INTEGER(KIND=INT64) :: start +TYPE(ff_type), INTENT(IN) :: ff +INTEGER(KIND=INT64), INTENT(IN) :: start INTEGER(KIND=INT64) :: POSITION POSITION = HUGE(0_int64) @@ -3059,8 +3059,8 @@ END FUNCTION f_shum_write_lookup FUNCTION commit_lookup(ff, message) RESULT(STATUS) IMPLICIT NONE -TYPE(ff_type) :: ff -CHARACTER(LEN=*) :: message +TYPE(ff_type), INTENT(IN OUT) :: ff +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=INT64) :: STATUS INTEGER(KIND=INT64) :: start diff --git a/shum_fieldsfile_class/src/f_shum_field.f90 b/shum_fieldsfile_class/src/f_shum_field.f90 index 4ca496f..04658b3 100644 --- a/shum_fieldsfile_class/src/f_shum_field.f90 +++ b/shum_fieldsfile_class/src/f_shum_field.f90 @@ -223,7 +223,7 @@ END FUNCTION get_lookup FUNCTION set_int_lookup_by_index(self, num_index, value_to_set) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(INOUT) :: self - INTEGER(KIND=int64) :: value_to_set, num_index + INTEGER(KIND=int64), INTENT(IN) :: value_to_set, num_index TYPE(shum_ff_status_type) :: status ! Return status object IF (num_index > len_integer_lookup .OR. num_index < 1_int64) THEN @@ -243,7 +243,8 @@ END FUNCTION set_int_lookup_by_index FUNCTION get_int_lookup_by_index(self, num_index, value_to_get) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: value_to_get, num_index + INTEGER(KIND=int64), INTENT(IN) :: num_index + INTEGER(KIND=int64), INTENT(OUT) :: value_to_get TYPE(shum_ff_status_type) :: status ! Return status object IF (num_index > len_integer_lookup .OR. num_index < 1_int64) THEN @@ -263,8 +264,8 @@ END FUNCTION get_int_lookup_by_index FUNCTION set_real_lookup_by_index(self, num_index, value_to_set) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(INOUT) :: self - INTEGER(KIND=int64) :: num_index - REAL(KIND=real64) :: value_to_set + INTEGER(KIND=int64), INTENT(IN) :: num_index + REAL(KIND=real64), INTENT(IN) :: value_to_set TYPE(shum_ff_status_type) :: status ! Return status object IF (num_index > len_integer_lookup + len_real_lookup .OR. & @@ -289,8 +290,8 @@ END FUNCTION set_real_lookup_by_index FUNCTION get_real_lookup_by_index(self, num_index, value_to_get) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: num_index - REAL(KIND=real64) :: value_to_get + INTEGER(KIND=int64), INTENT(IN) :: num_index + REAL(KIND=real64), INTENT(OUT) :: value_to_get TYPE(shum_ff_status_type) :: status ! Return status object IF (num_index > len_integer_lookup + len_real_lookup .OR. & @@ -317,7 +318,7 @@ FUNCTION get_stashcode(self, stashcode) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: lbuser4 IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: stashcode + INTEGER(KIND=int64), INTENT(OUT) :: stashcode TYPE(shum_ff_status_type) :: status ! Return status object IF (self%lookup_int(lbuser4) /= um_imdi) THEN @@ -338,7 +339,7 @@ FUNCTION get_timestring(self, timestring) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: lbyr, lbmon, lbdat, lbhr, lbmin, lbsec IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - CHARACTER(LEN=16) :: timestring + CHARACTER(LEN=16), INTENT(OUT) :: timestring INTEGER(KIND=int64) :: yr, mon, dat, hr, min, sec TYPE(shum_ff_status_type) :: status ! Return status object @@ -380,7 +381,7 @@ FUNCTION get_level_number(self, level_number) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: lblev IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: level_number + INTEGER(KIND=int64), INTENT(OUT) :: level_number TYPE(shum_ff_status_type) :: status ! Return status object level_number = self%lookup_int(lblev) @@ -395,7 +396,7 @@ FUNCTION get_level_eta(self, level_eta) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: blev IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - REAL(KIND=real64) :: level_eta + REAL(KIND=real64), INTENT(OUT) :: level_eta TYPE(shum_ff_status_type) :: status ! Return status object ! SHUMlib stores parameters containing the index in the 64-word lookup @@ -413,7 +414,7 @@ END FUNCTION get_level_eta FUNCTION get_real_fctime(self, real_fctime) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - REAL(KIND=real64) :: real_fctime + REAL(KIND=real64), INTENT(OUT) :: real_fctime TYPE(shum_ff_status_type) :: status ! Return status object real_fctime = self%fctime_real @@ -428,7 +429,7 @@ FUNCTION get_lbproc(self, proc) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: lbproc IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: proc + INTEGER(KIND=int64), INTENT(OUT) :: proc TYPE(shum_ff_status_type) :: status ! Return status object proc = self%lookup_int(lbproc) @@ -485,7 +486,7 @@ FUNCTION get_longitudes(self, longitudes) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self REAL(KIND=real64), ALLOCATABLE :: temp_longitudes(:) - REAL(KIND=real64), ALLOCATABLE :: longitudes(:) + REAL(KIND=real64), INTENT(OUT), ALLOCATABLE :: longitudes(:) TYPE(shum_ff_status_type) :: status ! Return status object IF (ALLOCATED(self%longitudes)) THEN @@ -532,7 +533,7 @@ FUNCTION get_latitudes(self, latitudes) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self REAL(KIND=real64), ALLOCATABLE :: temp_latitudes(:) - REAL(KIND=real64), ALLOCATABLE :: latitudes(:) + REAL(KIND=real64), INTENT(OUT), ALLOCATABLE :: latitudes(:) TYPE(shum_ff_status_type) :: status ! Return status object IF (ALLOCATED(self%latitudes)) THEN @@ -553,8 +554,8 @@ END FUNCTION get_latitudes FUNCTION get_coords(self, x, y, coords) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: x, y - REAL(KIND=real64) :: coords(2) + INTEGER(KIND=int64), INTENT(IN) :: x, y + REAL(KIND=real64), INTENT(OUT) :: coords(2) TYPE(shum_ff_status_type) :: status ! Return status object IF (x < 1_int64 .OR. x > SIZE(self%longitudes)) THEN @@ -584,7 +585,7 @@ FUNCTION get_pole_location(self, pole_location) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: bplon, bplat IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - REAL(KIND=real64) :: pole_location(2) + REAL(KIND=real64), INTENT(OUT) :: pole_location(2) TYPE(shum_ff_status_type) :: status ! Return status object ! SHUMlib stores parameters containing the index in the 64-word lookup @@ -634,7 +635,7 @@ FUNCTION get_rdata(self, rdata) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: lbrow, lbnpt IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - REAL(KIND=real64) :: rdata(self%lookup_int(lbnpt), & + REAL(KIND=real64), INTENT(OUT) :: rdata(self%lookup_int(lbnpt), & self%lookup_int(lbrow)) TYPE(shum_ff_status_type) :: status ! Return status object @@ -655,8 +656,8 @@ END FUNCTION get_rdata FUNCTION get_rdata_by_location(self, x, y, rdata) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: x, y - REAL(KIND=real64) :: rdata + INTEGER(KIND=int64), INTENT(IN) :: x, y + REAL(KIND=real64), INTENT(OUT) :: rdata TYPE(shum_ff_status_type) :: status ! Return status object IF (ALLOCATED(self%rdata)) THEN @@ -714,7 +715,7 @@ FUNCTION get_idata(self, idata) RESULT(status) USE f_shum_lookup_indices_mod, ONLY: lbrow, lbnpt IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: idata(self%lookup_int(lbnpt), & + INTEGER(KIND=int64), INTENT(OUT) :: idata(self%lookup_int(lbnpt), & self%lookup_int(lbrow)) TYPE(shum_ff_status_type) :: status ! Return status object @@ -735,8 +736,8 @@ END FUNCTION get_idata FUNCTION get_idata_by_location(self, x, y, idata) RESULT(status) IMPLICIT NONE CLASS(shum_field_type), INTENT(IN) :: self - INTEGER(KIND=int64) :: x, y - INTEGER(KIND=int64) :: idata + INTEGER(KIND=int64), INTENT(IN) :: x, y + INTEGER(KIND=int64), INTENT(OUT) :: idata TYPE(shum_ff_status_type) :: status ! Return status object IF (ALLOCATED(self%idata)) THEN diff --git a/shum_fieldsfile_class/src/f_shum_file.f90 b/shum_fieldsfile_class/src/f_shum_file.f90 index e2d22a1..d010212 100644 --- a/shum_fieldsfile_class/src/f_shum_file.f90 +++ b/shum_fieldsfile_class/src/f_shum_file.f90 @@ -138,8 +138,8 @@ FUNCTION open_file(self, fname, num_lookup, overwrite) RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN OUT) :: self CHARACTER(LEN=*), INTENT(IN) :: fname -INTEGER(KIND=INT64), OPTIONAL :: num_lookup -LOGICAL(KIND=bool), OPTIONAL :: overwrite +INTEGER(KIND=INT64), INTENT(IN), OPTIONAL :: num_lookup +LOGICAL(KIND=bool), INTENT(IN), OPTIONAL :: overwrite TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=INT64) :: lookup_size LOGICAL :: exists, read_only @@ -1908,7 +1908,7 @@ FUNCTION get_fixed_length_header(self, fixed_length_header) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -INTEGER(KIND=INT64) :: fixed_length_header(f_shum_fixed_length_header_len) +INTEGER(KIND=INT64), INTENT(OUT) :: fixed_length_header(f_shum_fixed_length_header_len) TYPE(shum_ff_status_type) :: STATUS ! Return status object fixed_length_header = self%fixed_length_header @@ -1923,7 +1923,7 @@ FUNCTION set_fixed_length_header_by_index(self, num_index, value_to_set) & RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN OUT) :: self -INTEGER(KIND=INT64) :: num_index, value_to_set +INTEGER(KIND=INT64), INTENT(IN) :: num_index, value_to_set TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (num_index < 1_int64 .OR. num_index > f_shum_fixed_length_header_len) & @@ -1944,7 +1944,8 @@ FUNCTION get_fixed_length_header_by_index(self, num_index, value_to_get) & RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN) :: self -INTEGER(KIND=INT64) :: num_index, value_to_get +INTEGER(KIND=INT64), INTENT(IN) :: num_index +INTEGER(KIND=INT64), INTENT(OUT) :: value_to_get TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (num_index < 1_int64 .OR. num_index > f_shum_fixed_length_header_len) & @@ -1996,7 +1997,7 @@ FUNCTION get_integer_constants(self, integer_constants) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -INTEGER(KIND=INT64), ALLOCATABLE :: integer_constants(:) +INTEGER(KIND=INT64), INTENT(IN OUT), ALLOCATABLE :: integer_constants(:) INTEGER(KIND=INT64) :: s_ic TYPE(shum_ff_status_type) :: STATUS ! Return status object @@ -2026,7 +2027,7 @@ FUNCTION set_integer_constants_by_index(self, num_index, value_to_set) & RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN OUT) :: self -INTEGER(KIND=INT64) :: num_index, value_to_set +INTEGER(KIND=INT64), INTENT(IN) :: num_index, value_to_set TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (.NOT. ALLOCATED(self%integer_constants)) THEN @@ -2050,7 +2051,8 @@ FUNCTION get_integer_constants_by_index(self, num_index, value_to_get) & RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN) :: self -INTEGER(KIND=INT64) :: num_index, value_to_get +INTEGER(KIND=INT64), INTENT(IN) :: num_index +INTEGER(KIND=INT64), INTENT(OUT) :: value_to_get TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (.NOT. ALLOCATED(self%integer_constants)) THEN @@ -2105,7 +2107,7 @@ FUNCTION get_real_constants(self, real_constants) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: real_constants(:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: real_constants(:) INTEGER(KIND=INT64) :: s_rc TYPE(shum_ff_status_type) :: STATUS ! Return status object @@ -2135,8 +2137,8 @@ FUNCTION set_real_constants_by_index(self, num_index, value_to_set) & RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN OUT) :: self -INTEGER(KIND=INT64) :: num_index -REAL(KIND=REAL64) :: value_to_set +INTEGER(KIND=INT64), INTENT(IN) :: num_index +REAL(KIND=REAL64), INTENT(IN) :: value_to_set TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (.NOT. ALLOCATED(self%real_constants)) THEN @@ -2160,8 +2162,8 @@ FUNCTION get_real_constants_by_index(self, num_index, value_to_get) & RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN) :: self -INTEGER(KIND=INT64) :: num_index -REAL(KIND=REAL64) :: value_to_get +INTEGER(KIND=INT64), INTENT(IN) :: num_index +REAL(KIND=REAL64), INTENT(OUT) :: value_to_get TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (.NOT. ALLOCATED(self%real_constants)) THEN @@ -2221,7 +2223,7 @@ FUNCTION get_level_dependent_constants(self, level_dependent_constants) & ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: level_dependent_constants(:,:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: level_dependent_constants(:,:) INTEGER(KIND=INT64) :: s_ldc1,s_ldc2 TYPE(shum_ff_status_type) :: STATUS ! Return status object @@ -2289,7 +2291,7 @@ FUNCTION get_row_dependent_constants(self, row_dependent_constants) & ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: row_dependent_constants(:,:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: row_dependent_constants(:,:) TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=int64) :: s_rdc1,s_rdc2 @@ -2361,7 +2363,7 @@ FUNCTION get_column_dependent_constants(self, column_dependent_constants) & ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: column_dependent_constants(:,:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: column_dependent_constants(:,:) TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=int64) :: s_cdc1,s_cdc2 @@ -2431,7 +2433,7 @@ FUNCTION get_additional_parameters(self, additional_parameters) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: additional_parameters(:,:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: additional_parameters(:,:) TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=int64) :: s_ap1, s_ap2 @@ -2498,7 +2500,7 @@ FUNCTION get_extra_constants(self, extra_constants) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: extra_constants(:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: extra_constants(:) TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=int64) :: s_ec @@ -2562,7 +2564,7 @@ FUNCTION get_temp_histfile(self, temp_histfile) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -REAL(KIND=REAL64), ALLOCATABLE :: temp_histfile(:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: temp_histfile(:) TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=int64) :: s_thf @@ -2596,7 +2598,7 @@ FUNCTION set_compressed_index(self, num_index, compressed_index) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN OUT) :: self -INTEGER(KIND=INT64) :: num_index +INTEGER(KIND=INT64), INTENT(IN) :: num_index REAL(KIND=REAL64), INTENT(IN) :: compressed_index(:) TYPE(shum_ff_status_type) :: STATUS ! Return status object @@ -2656,8 +2658,8 @@ FUNCTION get_compressed_index(self, num_index, compressed_index) RESULT(STATUS) ! Arguments CLASS(shum_file_type), INTENT(IN) :: self -INTEGER(KIND=INT64) :: num_index -REAL(KIND=REAL64), ALLOCATABLE :: compressed_index(:) +INTEGER(KIND=INT64), INTENT(IN) :: num_index +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: compressed_index(:) TYPE(shum_ff_status_type) :: STATUS ! Return status object INTEGER(KIND=int64) :: s_ci @@ -2736,7 +2738,7 @@ FUNCTION get_field(self, field_number, field) RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN) :: self INTEGER(KIND=INT64), INTENT(IN) :: field_number -TYPE(shum_field_type) :: field +TYPE(shum_field_type), INTENT(OUT) :: field TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (field_number > self%num_fields) THEN @@ -2783,7 +2785,7 @@ FUNCTION find_field_indices_in_file(self, found_field_indices, & INTEGER(KIND=INT64), OPTIONAL, INTENT(IN) :: max_returned_fields ! Returned list -INTEGER(KIND=INT64), ALLOCATABLE :: found_field_indices(:) +INTEGER(KIND=INT64), INTENT(IN OUT), ALLOCATABLE :: found_field_indices(:) ! Internal variables TYPE(shum_field_type) :: current_field @@ -2932,7 +2934,7 @@ FUNCTION find_fields_in_file(self, found_fields, max_returned_fields, & INTEGER(KIND=INT64), OPTIONAL, INTENT(IN) :: max_returned_fields ! Returned list -TYPE(shum_field_type), ALLOCATABLE :: found_fields(:) +TYPE(shum_field_type), INTENT(IN OUT), ALLOCATABLE :: found_fields(:) ! Local message string CHARACTER(LEN=256) :: cmessage @@ -3044,7 +3046,7 @@ FUNCTION find_forecast_time(self, found_fctime, stashcode) RESULT(STATUS) INTEGER(KIND=INT64), INTENT(IN) :: stashcode ! Returned list -REAL(KIND=REAL64), ALLOCATABLE :: found_fctime(:) +REAL(KIND=REAL64), INTENT(IN OUT), ALLOCATABLE :: found_fctime(:) TYPE(shum_ff_status_type) :: STATUS ! Return status object @@ -3077,7 +3079,7 @@ END FUNCTION find_forecast_time FUNCTION set_filename(self, fname) RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN OUT) :: self -CHARACTER(LEN=*) :: fname +CHARACTER(LEN=*), INTENT(IN) :: fname TYPE(shum_ff_status_type) :: STATUS ! Return status object IF (ALLOCATED(self%filename)) DEALLOCATE(self%filename) @@ -3092,7 +3094,7 @@ END FUNCTION set_filename FUNCTION get_filename(self, fname) RESULT(STATUS) IMPLICIT NONE CLASS(shum_file_type), INTENT(IN) :: self -CHARACTER(LEN=*) :: fname +CHARACTER(LEN=*), INTENT(OUT) :: fname TYPE(shum_ff_status_type) :: STATUS ! Return status object ! return empty string if filename is not allocated @@ -3207,7 +3209,7 @@ FUNCTION add_field(self, new_field) RESULT(STATUS) ! in the file. IMPLICIT NONE CLASS(shum_file_type), INTENT(IN OUT) :: self -TYPE(shum_field_type) :: new_field +TYPE(shum_field_type), INTENT(IN) :: new_field ! Internal variables TYPE(shum_field_type), ALLOCATABLE :: tmp_fields(:) diff --git a/shum_latlon_eq_grids/src/f_shum_latlon_eq_grids.f90 b/shum_latlon_eq_grids/src/f_shum_latlon_eq_grids.f90 index a1022bb..e7c19c0 100644 --- a/shum_latlon_eq_grids/src/f_shum_latlon_eq_grids.f90 +++ b/shum_latlon_eq_grids/src/f_shum_latlon_eq_grids.f90 @@ -101,7 +101,7 @@ FUNCTION f_shum_lltoeq_arg64 & REAL(KIND=real64), INTENT(OUT) :: phi_eq(SIZE(phi)) ! Lat (eq) REAL(KIND=real64), INTENT(OUT) :: lambda_eq(SIZE(phi)) ! Long (eq) -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status REAL(KIND=real64) :: a_lambda @@ -225,7 +225,7 @@ FUNCTION f_shum_lltoeq_arg64_single & REAL(KIND=real64) :: phi_eq_arr(1) REAL(KIND=real64) :: lambda_eq_arr(1) -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status phi_arr(1) = phi @@ -255,7 +255,7 @@ FUNCTION f_shum_lltoeq_arg32 & REAL(KIND=real32), INTENT(OUT) :: phi_eq(SIZE(phi)) ! Lat (eq) REAL(KIND=real32), INTENT(OUT) :: lambda_eq(SIZE(phi)) ! Long (eq) -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status @@ -315,7 +315,7 @@ FUNCTION f_shum_lltoeq_arg32_single & REAL(KIND=real64) :: phi_pole64 REAL(KIND=real64) :: lambda_pole64 -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status @@ -354,7 +354,7 @@ FUNCTION f_shum_eqtoll_arg64 & REAL(KIND=real64), INTENT(OUT) :: phi(SIZE(phi_eq)) ! Lat (lat-lon) REAL(KIND=real64), INTENT(OUT) :: lambda(SIZE(phi_eq)) ! Long (lat-lon) -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status REAL(KIND=real64) :: a_lambda @@ -478,7 +478,7 @@ FUNCTION f_shum_eqtoll_arg64_single & REAL(KIND=real64) :: phi_arr(1) REAL(KIND=real64) :: lambda_arr(1) -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status phi_eq_arr(1) = phi_eq @@ -508,7 +508,7 @@ FUNCTION f_shum_eqtoll_arg32 & REAL(KIND=real32), INTENT(OUT) :: phi(SIZE(phi_eq)) ! Lat (lat-lon) REAL(KIND=real32), INTENT(OUT) :: lambda(SIZE(phi_eq)) ! Long (lat-lon) -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status @@ -568,7 +568,7 @@ FUNCTION f_shum_eqtoll_arg32_single & REAL(KIND=real64) :: phi_pole64 REAL(KIND=real64) :: lambda_pole64 -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status @@ -606,7 +606,7 @@ FUNCTION f_shum_w_coeff_arg64 & REAL(KIND=real64), INTENT(OUT) :: coeff1(SIZE(lambda)) ! Rotation coeff 1 REAL(KIND=real64), INTENT(OUT) :: coeff2(SIZE(lambda)) ! Rotation coeff 2 -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status REAL(KIND=real64) :: a_lambda @@ -723,7 +723,7 @@ FUNCTION f_shum_w_coeff_arg32 & REAL(KIND=real32), INTENT(OUT) :: coeff1(SIZE(lambda)) ! Rotation coeff 1 REAL(KIND=real32), INTENT(OUT) :: coeff2(SIZE(lambda)) ! Rotation coeff 2 -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status @@ -777,7 +777,7 @@ FUNCTION f_shum_w_eqtoll_arg64 & REAL(KIND=real64), INTENT(OUT) :: v(SIZE(coeff1)) ! Wind U compt (lat-lon) REAL(KIND=real64), INTENT(IN), OPTIONAL :: mdi ! Missing data value -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status LOGICAL :: l_mdi ! Was an mdi value provided? @@ -830,7 +830,7 @@ FUNCTION f_shum_w_eqtoll_arg32 & REAL(KIND=real32), INTENT(OUT) :: v(SIZE(coeff1)) ! Wind U compt (lat-lon) REAL(KIND=real32), INTENT(IN), OPTIONAL :: mdi ! Missing data value -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status REAL(KIND=real64) :: coeff1_64(SIZE(coeff1)) @@ -892,7 +892,7 @@ FUNCTION f_shum_w_lltoeq_arg64 & REAL(KIND=real64), INTENT(OUT) :: v_eq(SIZE(coeff1)) ! Wind U compt (eq) REAL(KIND=real64), INTENT(IN), OPTIONAL :: mdi ! Missing data value -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status LOGICAL :: l_mdi ! Was an mdi value provided? @@ -945,7 +945,7 @@ FUNCTION f_shum_w_lltoeq_arg32 & REAL(KIND=real32), INTENT(OUT) :: v_eq(SIZE(coeff1)) ! Wind U compt (eq) REAL(KIND=real32), INTENT(IN), OPTIONAL :: mdi ! Missing data value -CHARACTER(LEN=*) :: message +CHARACTER(LEN=*), INTENT(OUT) :: message INTEGER(KIND=int64) :: status64 INTEGER(KIND=int32) :: status diff --git a/shum_number_tools/test/fruit_test_shum_number_tools.F90 b/shum_number_tools/test/fruit_test_shum_number_tools.F90 index cdffaad..82b467c 100644 --- a/shum_number_tools/test/fruit_test_shum_number_tools.F90 +++ b/shum_number_tools/test/fruit_test_shum_number_tools.F90 @@ -80,7 +80,7 @@ SUBROUTINE c_test_generate_fdenormal(denormal_float) & BIND(c,NAME="c_test_generate_fdenormal") IMPORT :: C_FLOAT IMPLICIT NONE - REAL(KIND=C_FLOAT) :: denormal_float + REAL(KIND=C_FLOAT), INTENT(OUT) :: denormal_float end subroutine c_test_generate_fdenormal END INTERFACE @@ -91,7 +91,7 @@ SUBROUTINE c_test_generate_ddenormal(denormal_double) & BIND(c,NAME="c_test_generate_ddenormal") IMPORT :: C_DOUBLE IMPLICIT NONE - REAL(KIND=C_DOUBLE) :: denormal_double + REAL(KIND=C_DOUBLE), INTENT(OUT) :: denormal_double end subroutine c_test_generate_ddenormal END INTERFACE diff --git a/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 b/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 index 90b340e..5fb7142 100644 --- a/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 +++ b/shum_spiral_search/test/fruit_test_shum_spiral_search.f90 @@ -130,7 +130,7 @@ SUBROUTINE sample_6x6_data_32 & LOGICAL(KIND=bool), INTENT(OUT) :: lsm(36) LOGICAL(KIND=bool), INTENT(OUT) :: unres_mask(36) INTEGER(KIND=int32), INTENT(OUT) :: index_unres(5) -REAL(KIND=real32) :: planet_radius +REAL(KIND=real32), INTENT(OUT) :: planet_radius REAL(KIND=real64) :: latitude_64(6) REAL(KIND=real64) :: longitude_64(6) diff --git a/shum_string_conv/src/f_shum_string_conv.f90 b/shum_string_conv/src/f_shum_string_conv.f90 index f6b56f7..85b1710 100644 --- a/shum_string_conv/src/f_shum_string_conv.f90 +++ b/shum_string_conv/src/f_shum_string_conv.f90 @@ -77,7 +77,7 @@ FUNCTION c_strlen_integer_cstr(cstr) IMPLICIT NONE -CHARACTER(KIND=C_CHAR,LEN=1), TARGET :: cstr(*) +CHARACTER(KIND=C_CHAR,LEN=1), INTENT(IN), TARGET :: cstr(*) INTEGER(KIND=C_INT64_T) :: c_strlen_integer_cstr c_strlen_integer_cstr = INT(c_std_strlen(cstr), KIND=C_INT64_T) @@ -95,7 +95,8 @@ FUNCTION c2f_string_cstr(cstr, cstr_len) IMPLICIT NONE -INTEGER(KIND=C_INT64_T) :: cstr_len, i +INTEGER(KIND=C_INT64_T), INTENT(IN) :: cstr_len +INTEGER(KIND=C_INT64_T) :: i CHARACTER(KIND=C_CHAR,LEN=1), INTENT(IN) :: cstr(cstr_len) CHARACTER(LEN=cstr_len) :: c2f_string_cstr @@ -114,7 +115,8 @@ FUNCTION c2f_string_cptr(cptr, cstr_len) IMPLICIT NONE -INTEGER(KIND=C_INT64_T) :: cstr_len, i +INTEGER(KIND=C_INT64_T), INTENT(IN) :: cstr_len +INTEGER(KIND=C_INT64_T) :: i TYPE(C_PTR), INTENT(IN) :: cptr CHARACTER(KIND=C_CHAR, LEN=1), POINTER :: fptr(:) CHARACTER(LEN=cstr_len) :: c2f_string_cptr diff --git a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 index e0b9d9c..8b1b966 100644 --- a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 +++ b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 @@ -135,7 +135,7 @@ SUBROUTINE c_test_inpar(test_ret,par) & IMPLICIT NONE LOGICAL(KIND=C_BOOL), INTENT(OUT) :: test_ret - INTEGER(KIND=C_INT64_T) :: par + INTEGER(KIND=C_INT64_T), INTENT(OUT) :: par END SUBROUTINE c_test_inpar @@ -149,7 +149,7 @@ SUBROUTINE c_test_threadid(test_ret,tid) & IMPLICIT NONE LOGICAL(KIND=C_BOOL), INTENT(OUT) :: test_ret - INTEGER(KIND=C_INT64_T) :: tid + INTEGER(KIND=C_INT64_T), INTENT(OUT) :: tid END SUBROUTINE c_test_threadid @@ -163,7 +163,7 @@ SUBROUTINE c_test_numthreads(test_ret,numthreads) & IMPLICIT NONE LOGICAL(KIND=C_BOOL), INTENT(OUT) :: test_ret - INTEGER(KIND=C_INT64_T) :: numthreads + INTEGER(KIND=C_INT64_T), INTENT(OUT) :: numthreads END SUBROUTINE c_test_numthreads @@ -177,7 +177,7 @@ SUBROUTINE c_test_threadflush(test_ret,shared1) & IMPLICIT NONE LOGICAL(KIND=C_BOOL), INTENT(OUT) :: test_ret - INTEGER(KIND=C_INT64_T) :: shared1 + INTEGER(KIND=C_INT64_T), INTENT(IN) :: shared1 END SUBROUTINE c_test_threadflush diff --git a/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 b/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 index 396b9c9..b7a5e23 100644 --- a/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 +++ b/shum_wgdos_packing/test/fruit_test_shum_wgdos_packing.f90 @@ -197,9 +197,9 @@ END SUBROUTINE sample_unpacked_data_1d SUBROUTINE sample_packed_data(sample) IMPLICIT NONE -INTEGER(KIND=int32) :: sample(21) -INTEGER(KIND=int32), POINTER :: sample_pointer(:) -INTEGER(KIND=int64), TARGET :: sample64(11) +INTEGER(KIND=int32), INTENT(OUT) :: sample(21) +INTEGER(KIND=int32), POINTER :: sample_pointer(:) +INTEGER(KIND=int64), TARGET :: sample64(11) ! Define the data as a 64-bit array. The reason for this is that although the ! packing algorithm represents the data as 32-bit, the actual array is just a From 8e3cbb069c6fb2d17490fce2b24c7d4643d28446 Mon Sep 17 00:00:00 2001 From: Sam Clarke-Green Date: Wed, 11 Feb 2026 15:02:02 +0000 Subject: [PATCH 8/8] Fix missing-exit-or-cycle-label --- shum_number_tools/src/f_shum_is_denormal.F90 | 6 +++--- shum_number_tools/src/f_shum_is_inf.F90 | 6 +++--- shum_number_tools/src/f_shum_is_nan.F90 | 6 +++--- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/shum_number_tools/src/f_shum_is_denormal.F90 b/shum_number_tools/src/f_shum_is_denormal.F90 index ce0cef1..9123c78 100644 --- a/shum_number_tools/src/f_shum_is_denormal.F90 +++ b/shum_number_tools/src/f_shum_is_denormal.F90 @@ -209,10 +209,10 @@ LOGICAL FUNCTION f_shum_has_denormal32(x) ! Loop over elements of x and determine if any are infinite ! Exit immediately if any are found -DO ix=1,SIZE(x) +HAS_INF: DO ix=1,SIZE(x) f_shum_has_denormal32 = f_shum_is_denormal32(x(ix)) - IF (f_shum_has_denormal32) EXIT -END DO + IF (f_shum_has_denormal32) EXIT HAS_INF +END DO HAS_INF END FUNCTION f_shum_has_denormal32 diff --git a/shum_number_tools/src/f_shum_is_inf.F90 b/shum_number_tools/src/f_shum_is_inf.F90 index afbcac6..b9fa03a 100644 --- a/shum_number_tools/src/f_shum_is_inf.F90 +++ b/shum_number_tools/src/f_shum_is_inf.F90 @@ -180,10 +180,10 @@ LOGICAL FUNCTION f_shum_has_inf32(x) ! Loop over elements of x and determine if any are infinite ! Exit immediately if any are found -DO ix=1,SIZE(x) +HAS_INF: DO ix=1,SIZE(x) f_shum_has_inf32 = f_shum_is_inf32(x(ix)) - IF (f_shum_has_inf32) EXIT -END DO + IF (f_shum_has_inf32) EXIT HAS_INF +END DO HAS_INF END FUNCTION f_shum_has_inf32 diff --git a/shum_number_tools/src/f_shum_is_nan.F90 b/shum_number_tools/src/f_shum_is_nan.F90 index 55afa43..2fcf7d4 100644 --- a/shum_number_tools/src/f_shum_is_nan.F90 +++ b/shum_number_tools/src/f_shum_is_nan.F90 @@ -220,10 +220,10 @@ LOGICAL FUNCTION f_shum_has_nan32(x) ! Loop over elements of x and determine if any are NaNs ! Exit immediately if any are found -DO ix=1,SIZE(x) +HAS_NAN: DO ix=1,SIZE(x) f_shum_has_nan32 = f_shum_is_nan32(x(ix)) - IF (f_shum_has_nan32) EXIT -END DO + IF (f_shum_has_nan32) EXIT HAS_NAN +END DO HAS_NAN END FUNCTION f_shum_has_nan32