run_wrapper Subroutine

public subroutine run_wrapper(wrapper, args, verbose, exitcode, cmd_success, screen_output)

Simple call to execute_command_line involving one mpi* wrapper

Arguments

Type IntentOptional Attributes Name
type(string_t), intent(in) :: wrapper
type(string_t), intent(in), optional :: args(:)
logical, intent(in), optional :: verbose
integer, intent(out), optional :: exitcode
logical, intent(out), optional :: cmd_success
type(string_t), intent(out), optional :: screen_output

Source Code

subroutine run_wrapper(wrapper,args,verbose,exitcode,cmd_success,screen_output)
    type(string_t), intent(in) :: wrapper
    type(string_t), intent(in), optional :: args(:)
    logical, intent(in), optional :: verbose
    integer, intent(out), optional :: exitcode
    logical, intent(out), optional :: cmd_success
    type(string_t), intent(out), optional :: screen_output

    logical :: echo_local
    character(:), allocatable :: redirect_str,command,redirect,line
    integer :: iunit,iarg,stat,cmdstat


    if(present(verbose))then
       echo_local=verbose
    else
       echo_local=.false.
    end if

    ! No redirection and non-verbose output
    if (present(screen_output)) then
        redirect = get_temp_filename()
        redirect_str =  ">"//redirect//" 2>&1"
    else
        if (os_is_unix()) then
            redirect_str = " >/dev/null 2>&1"
        else
            redirect_str = " >NUL 2>&1"
        end if
    end if

    ! Empty command
    if (len_trim(wrapper)<=0) then
        if (echo_local) print *, '+ <EMPTY COMMAND>'
        if (present(exitcode)) exitcode = 0
        if (present(cmd_success)) cmd_success = .true.
        if (present(screen_output)) screen_output = string_t("")
        return
    end if

    ! Init command
    command = trim(wrapper%s)

    add_arguments: if (present(args)) then
        do iarg=1,size(args)
            if (len_trim(args(iarg))<=0) cycle
            command = trim(command)//' '//args(iarg)%s
        end do
    endif add_arguments

    if (echo_local) print *, '+ ', command

    ! Test command
    call execute_command_line(command//redirect_str,exitstat=stat,cmdstat=cmdstat)

    ! Command successful?
    if (present(cmd_success)) cmd_success = cmdstat==0

    ! Program exit code?
    if (present(exitcode)) exitcode = stat

    ! Want screen output?
    if (present(screen_output) .and. cmdstat==0) then

        allocate(character(len=0) :: screen_output%s)

        open(newunit=iunit,file=redirect,status='old',iostat=stat)
        if (stat == 0)then
           do
               call getline(iunit, line, stat)
               if (stat /= 0) exit

               screen_output%s = screen_output%s//new_line('a')//line

               if (echo_local) write(*,'(A)') trim(line)
           end do

           ! Close and delete file
           close(iunit,status='delete')

        else
           call fpm_stop(1,'cannot read temporary file from successful MPI wrapper')
        endif

    end if

end subroutine run_wrapper