Hi all,
I have a new conundrum. After thoroughly reading the gfortran entry on execute_command_line, How would one be able to send a SIGKILL or a SIGTERM to the process, if said signals are ignored by the child process ?
Going back to my previous program that I posted
Here is what the code looks like now after using the solution @jacobwilliams provided me
Compiled with : gfortran -O3 pipes_module.f90 main.f90 -o test
main :
program main
use pipes_module
implicit none
character(len=*),parameter :: filename="multi_core",&
compile_multi_core_backend="caf -O3 multi_core.f90 -o multi_core"
integer,parameter :: max_cores=12
character(len=:),allocatable :: greetings
character(len=1000) :: run_multi_core_backend
character(len=1) :: recompile_answer
integer :: number_of_cores
logical :: ex
inquire(file=filename,exist=ex)
select case (ex)
case (.false.)
print "(a)", "Doesn't exist"
print "(a)", "Compiling.."
call execute_command_line (compile_multi_core_backend)
call select_cores_and_run()
case (.true.)
print "(a)", "It exists!"
write(unit=*,fmt="(a,1x)",advance="no") "Do you want to recompile it?"
read *, recompile_answer
select case (recompile_answer)
case ("y")
print "(a)", "Compiling.."
call execute_command_line(compile_multi_core_backend)
call select_cores_and_run()
case ("Y")
print "(a)", "Compiling.."
call execute_command_line(compile_multi_core_backend)
call select_cores_and_run()
case("n")
call select_cores_and_run()
case("N")
call select_cores_and_run()
end select
end select
write(unit=*,fmt="(a,a)") greetings
contains
subroutine select_cores_and_run()
write(unit=*,fmt="(a,1x)",advance="no")&
"How many cores do you want?"
read *, number_of_cores
if (number_of_cores .gt. max_cores) STOP "Error: Too many cores !"
write(unit=run_multi_core_backend,fmt="(a,1x,a,1x,i0,1x,a)")&
"cafrun","-n",number_of_cores,"./multi_core"
greetings = get_command_as_string(run_multi_core_backend)
end subroutine select_cores_and_run
end program main
pipes module :
module pipes_module
use,intrinsic :: iso_c_binding
implicit none
private
interface
function popen(command, mode) bind(C,name='popen')
import :: c_char, c_ptr
character(kind=c_char),dimension(*) :: command
character(kind=c_char),dimension(*) :: mode
type(c_ptr) :: popen
end function popen
function fgets(s,siz,stream) bind(C,name='fgets')
import :: c_char, c_ptr, c_int
type (c_ptr) :: fgets
character (kind=c_char),dimension(*) :: s
integer(kind=c_int), value :: siz
type(c_ptr), value :: stream
end function fgets
function pclose(stream) bind(C,name='pclose')
import :: c_ptr, c_int
integer(c_int) :: pclose
type(c_ptr),value :: stream
end function pclose
end interface
public :: convert_string_from_c2f, get_command_as_string
contains
function convert_string_from_c2f(c) result(f)
implicit none
character(len=*),intent(in) :: c
character(len=:),allocatable :: f
integer :: i
i=index(C,c_null_char)
if (i .le. 0) then
f = c
else if (i .eq. 1) then
f = ''
else if (i .gt. 1) then
f = c(1:i-1)
end if
end function convert_string_from_c2f
function get_command_as_string(command) result(str)
implicit none
character(len=*),intent(in) :: command
character(len=:),allocatable :: str
integer,parameter :: buffer_length = 1000
type(c_ptr) :: h
integer(c_int) :: istat
character(kind=c_char,len=buffer_length) :: line
str = ''
h = c_null_ptr
h = popen(command//c_null_char,'r'//c_null_char)
if (c_associated(h)) then
do while (c_associated(fgets(line, buffer_length, h)))
str = str//convert_string_from_c2f(line)
end do
istat = pclose(h)
end if
end function get_command_as_string
end module pipes_module
multi core main :
program multi_main
implicit none
print "(a,1x,i0)", "Hello from",this_image()
end program multi_main
