@@ -134,7 +134,7 @@ contains
134134 if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg)
135135 end
136136
137- module subroutine load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg)
137+ subroutine load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg)
138138 type(t_unzipped_bundle), intent(in) :: unzipped_bundle
139139 type(t_array_wrapper), allocatable, intent(out) :: arrays(:)
140140 integer, intent(out) :: stat
@@ -204,7 +204,7 @@ contains
204204 end
205205
206206 !> Open file and try to identify the cause of the error that occurred during unzip.
207- module subroutine identify_unzip_problem(filename, stat, msg)
207+ subroutine identify_unzip_problem(filename, stat, msg)
208208 character(len=*), intent(in) :: filename
209209 integer, intent(inout) :: stat
210210 character(len=:), allocatable, intent(inout) :: msg
@@ -232,7 +232,7 @@ contains
232232 stat = prev_stat; msg = 'Failed to unzip file: '//filename//nl//prev_msg
233233 end
234234
235- module subroutine verify_header(io_unit, stat, msg)
235+ subroutine verify_header(io_unit, stat, msg)
236236 integer, intent(in) :: io_unit
237237 integer, intent(out) :: stat
238238 character(len=:), allocatable, intent(out) :: msg
0 commit comments