install.f90 Source File


Source Code

program main
   use mpi

   integer :: i, n, ierr, my_rank, petot, fh
   character*17 :: FileName
   character*17 :: Filelist
   character*200 :: command

   call mpi_init(ierr)
   call mpi_comm_size(mpi_comm_world, petot, ierr)
   call mpi_comm_rank(mpi_comm_world, my_rank, ierr)
   fh = my_rank + 10
   write (FileName, '(".install", i6.6, ".sh")') my_rank + 1
   write (Filelist, '(".flist__", i6.6, ".sh")') my_rank + 1
   ! create file list
   open (fh + 100, file=".install_list", status="old")
   open (fh + 200, file=Filelist, status="replace")
   n = 0
   do i = 1, 28
      n = n + 1
      read (fh + 100, '(A)') command
      if (i < 15) then
         n = 0
         write (fh + 200, '(A)') command
         cycle
      end if

      if (my_rank + 1 == n) then
         n = 0
         write (fh + 200, '(A)') command
         cycle
      end if
   end do
   close (fh + 100)
   close (fh + 200)
   call mpi_barrier(mpi_comm_world, ierr)

   ! create shell script
   open (fh, file=FileName)
   write (fh, '(A)') '#!/bin/sh -eu'

   !write(fh,'(A)') 'retry() {'
   !write(fh,'(A)') 'max_attempts=10'
   !write(fh,'(A)') 'cmd=10'
   !write(fh,'(A)') 'attempt_num=1'
   !write(fh,'(A)') 'until $cmd'
   !write(fh,'(A)') 'do'
   !write(fh,'(A)') '    if (( attempt_num == max_attempts ))'
   !write(fh,'(A)') '    then'
   !write(fh,'(A)') '        echo "Attempt $attempt_num failed and there are no more attempts left!"'
   !write(fh,'(A)') '        return 1'
   !write(fh,'(A)') '    else'
   !write(fh,'(A)') '        echo "Attempt $attempt_num failed! Trying again in $attempt_num seconds..."'
   !write(fh,'(A)') '        sleep 0'
   !write(fh,'(A)') '    fi'
   !write(fh,'(A)') 'done'
   !write(fh,'(A)') '}'

   write (fh, '(A)') "while read line"
   write (fh, '(A)') "do"
   write (fh, '(A)') 'echo "------------------------"'
   write (fh, '(A)') "echo $line"
   write (fh, '(A)') "$line"
   write (fh, '(A)') "done < "//Filelist
   close (fh)

   command = "sh "//FileName
   print *, command
   call execute_command_line(command)
   call mpi_finalize(ierr)
end program