feat(io): download archive if .dat files not found

Author: rouson

src/mod_io_submodule.f90

@@ -2,16 +2,52 @@
 
   implicit none
 
+  integer, parameter :: message_len = 128
 contains
 
+  subroutine download_and_uncompress()
+    character(len=*), parameter :: download_mechanism = 'curl -LO '
+    character(len=*), parameter :: base_url='https://github.com/modern-fortran/neural-fortran/files/8498876/'
+    character(len=*), parameter :: download_filename = 'mnist.tar.gz'
+    character(len=*), parameter :: download_command = download_mechanism // base_url //download_filename
+    character(len=*), parameter :: uncompress_file= 'tar xvzf ' // download_filename
+    character(len=message_len) :: command_message
+    character(len=:), allocatable :: error_message
+    integer exit_status, command_status
+    exit_status=0
+    call execute_command_line(command=download_command, &
+      wait=.true., exitstat=exit_status, cmdstat=command_status, cmdmsg=command_message)
+    if (any([exit_status, command_status]/=0)) then
+      error_message = 'command "' // download_command // '" failed'
+      if (command_status/=0) error_message = error_message // " with message " // trim(command_message)
+      error stop  error_message
+    end if
+    call execute_command_line(command=uncompress_file , &
+      wait=.true., exitstat=exit_status, cmdstat=command_status, cmdmsg=command_message)
+    if (any([exit_status, command_status]/=0)) then
+      error_message = 'command "' // uncompress_file // '" failed'
+      if (command_status/=0) error_message = error_message // " with message " // trim(command_message)
+      error stop  error_message
+    end if
+  end subroutine
+
   module subroutine read_binary_file_1d(filename, dtype, nrec, array)
     character(len=*), intent(in) :: filename
     integer(ik), intent(in) :: dtype, nrec
     real(rk), allocatable, intent(in out) :: array(:)
     integer(ik) :: fileunit
-    allocate(array(nrec))
+    character(len=message_len) io_message, command_message
+    integer io_status
+    io_status=0
     open(newunit=fileunit, file=filename, access='direct',&
-         action='read', recl=dtype * nrec, status='old')
+         action='read', recl=dtype * nrec, status='old', iostat=io_status)
+    if (io_status/=0) then
+      call download_and_uncompress
+      open(newunit=fileunit, file=filename, access='direct',&
+         action='read', recl=dtype * nrec, status='old', iostat=io_status, iomsg=io_message)
+      if (io_status/=0) error stop trim(io_message)
+    end if
+    allocate(array(nrec))
     read(fileunit, rec=1) array
     close(fileunit)
   end subroutine read_binary_file_1d
@@ -21,6 +57,16 @@ module subroutine read_binary_file_2d(filename, dtype, dsize, nrec, array)
     integer(ik), intent(in) :: dtype, dsize, nrec
     real(rk), allocatable, intent(in out) :: array(:,:)
     integer(ik) :: fileunit, i
+    character(len=message_len) io_message, command_message
+    integer io_status
+    open(newunit=fileunit, file=filename, access='direct',&
+         action='read', recl=dtype * nrec, status='old', iostat=io_status)
+    if (io_status/=0) then
+      call download_and_uncompress
+      open(newunit=fileunit, file=filename, access='direct',&
+         action='read', recl=dtype * nrec, status='old', iostat=io_status, iomsg=io_message)
+      if (io_status/=0) error stop trim(io_message)
+    end if
     allocate(array(dsize, nrec))
     open(newunit=fileunit, file=filename, access='direct',&
          action='read', recl=dtype * dsize, status='old')

src/mod_mnist_submodule.f90

@@ -43,20 +43,20 @@ module subroutine load_mnist(tr_images, tr_labels, te_images,&
     integer(ik), parameter :: te_nimages = 10000
     integer(ik), parameter :: va_nimages = 10000
 
-    call read_binary_file('data/mnist/mnist_training_images.dat',&
+    call read_binary_file('mnist_training_images.dat',&
                           dtype, image_size, tr_nimages, tr_images)
-    call read_binary_file('data/mnist/mnist_training_labels.dat',&
+    call read_binary_file('mnist_training_labels.dat',&
                           dtype, tr_nimages, tr_labels)
 
-    call read_binary_file('data/mnist/mnist_testing_images.dat',&
+    call read_binary_file('mnist_testing_images.dat',&
                           dtype, image_size, te_nimages, te_images)
-    call read_binary_file('data/mnist/mnist_testing_labels.dat',&
+    call read_binary_file('mnist_testing_labels.dat',&
                           dtype, te_nimages, te_labels)
 
     if (present(va_images) .and. present(va_labels)) then
-      call read_binary_file('data/mnist/mnist_validation_images.dat',&
+      call read_binary_file('mnist_validation_images.dat',&
                             dtype, image_size, va_nimages, va_images)
-      call read_binary_file('data/mnist/mnist_validation_labels.dat',&
+      call read_binary_file('mnist_validation_labels.dat',&
                             dtype, va_nimages, va_labels)
     end if