Программа Fortran 95 с несовпадением рангов, связанным с вызовом подпрограммы - PullRequest
0 голосов
/ 07 ноября 2019

У меня есть программа на Фортране 95, работающая в CodeBlocks 17.12. Эта программа не будет создаваться из-за проблемы несоответствия рангов, связанной с вызовом подпрограммы. Это единственная проблема со сборкой. Я прилагаю код ниже.

Что я должен сделать, чтобы решить эту проблему? Я пытался решить эту проблему в течение трех дней.


program GNUPLOT_Control



    implicit none

!*********************************************************************
!
! Below are default parameters which control linewidth, colors and terminal type
!
!*********************************************************************

    character(len=3),   parameter   :: default_linewidth='1'
    character(len=100), parameter   :: default_color1='blue'
    character(len=100), parameter   :: default_color2='dark-green'
    character(len=100), parameter   :: default_color3='orange-red'
    character(len=100), parameter   :: default_color4='dark-salmon'
    character(len=100), parameter   :: default_terminal='wxt'
    character(len=100), parameter   :: default_palette='CMY'

!*********************************************************************

!       Set up an interface block for the program subroutines

!*********************************************************************

   interface

   subroutine plot_1(x1,y1,style,pause_in,color1,terminal,filename,polar,persist,input,linewidth)

    intent (in) x1,y1, style, pause_in,color1,terminal,filename,polar,persist,input,linewidth

    end subroutine

    subroutine read_date_and_time(f_result)

     intent(in) f_result

     end subroutine

    subroutine output_terminal(f_result_1)

    intent(in) f_result_1

    end subroutine

    end interface

!*********************************************************************

!    Declare and define by type variables related to the following subroutines

!*********************************************************************


    real                            :: x1(100),y1(100)

    integer                         :: i, ierror, ios, file_unit, Nx1
    integer                         :: pause_in=-1
    integer, parameter              :: Nc=20

    character(len=8),parameter      :: linewidth='1'
    character(len=100)              :: output_terminal_1
    character(len=30),parameter     :: style='linespoints'
    character(len=8),parameter      :: color1='red', terminal='wxt', filename='harry'  !*******
    character(len=8),parameter      :: polar='no', persist='-p', input='fang'
    character(len=100)              :: data_file_name, command_file_name, my_linewidth
    character(len=100)              :: my_date_and_time
    character(len=20)               :: my_line_type1, my_color1, my_range, my_pause, my_persist

    character(len=*),parameter      :: pause='-1'

!*********************************************************************

!    Define the x1 and y1 values to plot a parabola below,
!             using the x1 and y1 arrays

!*********************************************************************

    do i = 1,21

        x1(i)=-1 +(i-1)*0.1
        y1(i)= x1(i)*x1(i)

    end do

!*********************************************************************

!    Call the subroutine plot_1 to define the plot files required
!           for gnuplot to draw the parabola defined above

!*********************************************************************

!** This is the subroutine call statement causing the Rank Mismatch - x1 scalar and rank-1 error ****

    call plot_1(x1,y1,style,pause_in,color1,terminal,filename,polar,persist,input,linewidth)


    end program GNUPLOT_Control

!*********************************************************************

!*********************************************************************
!*********************************************************************

!                 Subroutines follow

!*********************************************************************
!*********************************************************************

!*********************************************************************
!*********************************************************************

    subroutine read_date_and_time(f_result)

!*********************************************************************
!*********************************************************************

!*********************************************************************
!
!   This subroutine creates a string, f_result, with the current
!   date and time.  f_result is used to timestamp output files
!
!*********************************************************************

    implicit none

        character(len=8)  :: date
        character(len=10) :: time
        character(len=33) :: f_result

    call date_and_time(date,time)

   f_result= 'Date '//date(7:8)//'-'//date(5:6)//'-'//date(1:4)//' Time is '//time(1:2)//':'//time(3:4)//' '


    end subroutine read_date_and_time

!*********************************************************************

!*********************************************************************
!*********************************************************************

    subroutine output_terminal(f_result1)

!*********************************************************************
!*********************************************************************

!*********************************************************************

!  This subroutine defines the terminal type to be used by gnuplot.
!  It uploads the selected terminal type using string variable f_result1

!*********************************************************************

    implicit none

    character(len=50)               :: terminal_1
    integer                         :: Nc=35
    character(len=20)               :: f_result1

    f_result1 = terminal_1

    end subroutine output_terminal

!*******************************************************************

!*******************************************************************
!*********************************************************************

    subroutine plot_1(x1,y1,style,pause_in,color1,terminal,filename,polar,persist,input,linewidth)

!*********************************************************************
!*********************************************************************

!*********************************************************************
!
!   This subroutine takes in and formats all of the desired settings
!   listed in the call statement, creating a data.txt file and associoated
!   command plot file, command.plt to define and control the output plot
!   created and drawn by gnuplot.
!
!   It then plots one two-dimensional line graph using the x1 and y1 arrays
!   passed into it after taking them in from the main program
!
!*********************************************************************

    implicit none

    real(kind=8), intent(in)    :: x1(100), y1(100)
    real(kind=8),optional       :: linewidth

    integer                     :: len
    integer                     :: i, ierror, ios, file_unit, Nx1, Nx2
    integer,optional            :: pause_in
    integer                     :: Nc=20

    character(len=*),optional   :: color1, terminal, filename, polar, persist, input
    character(len=*),parameter  :: pause='-1'

    character(len=*), optional  :: style
    character(len=100)          :: data_file_name, command_file_name, my_linewidth
    character(len=100)          :: default_color1, default_linewidth,default_terminal
    character(len=100)          :: output_terminal, my_date_and_time
    character(len=20)           :: my_line_type1, my_color1, my_range, my_pause, my_persist

!*********************************************************************
!
!   Define the names for the command file and data file below

!*********************************************************************

    if (present(input)) then
        data_file_name='data_file_'//input//'.txt'
        command_file_name='command_file_'//input//'.txt'
    else
        data_file_name='data_file.txt'
        command_file_name='command_file.txt'

    end if

!*********************************************************************
!
!   Check to see if the length of the X1 and y1 data arrays are the same
!
!*********************************************************************

    Nx1=size(x1)

    if ((size(x1).ne.size(y1))) then
        print *,'subroutine plot ERROR: size(x) is not equal to size(y)'
        stop

    end if

!*********************************************************************
!
!   Check to see if the style variable length is longer than 3 characters
!
!*********************************************************************
!
!
!*********************************************************************
!
!   Call get_unit(file_unit) to get an available file_unit number
!   into which the subroutine can use to write all of the x1 and y1 array
!   data into the data.txt file to be used by gnuplot later
!
!*********************************************************************

    ierror=0

    call get_unit(file_unit)
    if (file_unit==0) then
        ierror=1
        print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'

        Stop

    end if

    open (unit=file_unit, file=data_file_name, status='replace', iostat=ios)

    if (ios/=0) then
        ierror=2
        print *,'write_vector_data - fatal error! Could not open the terminal data file.'

        Stop

    end if

!********************************************************************
!
!    Write plot data, from the x1 and y1 arrays into the plot data file
!
!    Later this data will be written into the datafile.txt
!
!*********************************************************************

    do i=1,Nx1
        write (file_unit,'(2E15.7)') x1(i), y1(i)

    end do

!*********************************************************************

    close (unit=file_unit)

!*********************************************************************

!*********************************************************************
!
!   Call get_unit(file_unit) to get the an available file_unit number
!   into which the subroutine can use to write the linestyle, linetype,
!   (lines, linespoints or points), linewidth, line color, and other
!    plotting variable alues to be used by gnuplot later
!
!*********************************************************************

    ierror = 0

    call get_unit(file_unit)
    if (file_unit==0) then
        ierror=1
        print *,'write_vector_data - fatal error! Could not get a free FORTRAN unit.'
        Stop

    end if

    open (unit=file_unit, file=command_file_name, status='replace', iostat=ios)
    if (ios/=0) then
        ierror=2
        print *,'write_vector_data - fatal error! Could not open the terminal command file.'
        Stop

    end if

!*********************************************************************
!
!   Define the value for the type of line to be drawn by gnuplot
!
!*********************************************************************

    my_line_type1='lines'

    if (present(style)) then
    if ((style(3:3)=='-')) then

        my_line_type1='linespoints'
    else
        my_line_type1='points'

    end if

    end if

!*********************************************************************
!
!   Define the value for the linewidth to be drawn by gnuplot
!
!*********************************************************************


    if (present(linewidth)) then
        write ( my_linewidth,'(e9.3)') linewidth
    else
        my_linewidth=trim(default_linewidth)

    end if

!*********************************************************************
!
!   Define the value for the line color to be drawn by gnuplot
!
!*********************************************************************


    if (present(color1)) then
        my_color1='"'//trim(color1)//'"'
    else
        my_color1='"'//trim(default_color1)//'"'

    end if

!*********************************************************************
!
!   Define and write the values for the persistence, terminal output
!   filename, output timestamp, and default output screen used by
!   gnuplot for controlling the data plot
!
!*********************************************************************

    my_persist='persist '

    if (present(persist).and.(persist=='no')) my_persist=' '
    if (present(terminal)) then
        write ( file_unit, '(a)' ) 'set terminal '// trim(output_terminal)
    if (present(filename)) then
        write ( file_unit, '(a)' ) 'set output "'// trim(filename) //'"'
    else
        write ( file_unit, '(a)' ) 'set output "'//my_date_and_time()//'"'

    end if

    else
        write ( file_unit, '(a)' ) 'set terminal ' // trim(default_terminal) // ' ' &
            & //trim(my_persist) //' title  "Gnuplot"'

    end if

!*********************************************************************
!
!   Define and write the values for the values related to the key value,
!   xrange, yrange, size square, polar, polar grid, or rectangular
!   grid for controlling the gnuplot data plot
!
!*********************************************************************

    write ( file_unit, '(a)' ) 'unset key'
    if (present(polar).and.(polar=='yes')) then
        write (my_range,'(e15.7)') maxval(abs(y1))
        write ( file_unit, '(a)' ) 'set xrange [-'//trim(my_range)//':'//trim(my_range)//']'
        write ( file_unit, '(a)' ) 'set yrange [-'//trim(my_range)//':'//trim(my_range)//']'
        write ( file_unit, '(a)' ) 'set size square'
        write ( file_unit, '(a)' ) 'set polar'
        write ( file_unit, '(a)' ) 'set grid polar'
    else
        write ( file_unit, '(a)' ) 'set grid'

    end if

!*********************************************************************
!
!   Define and write the values for the values related to the line type,
!   line width, point type, line color into the data file.txt
!   for controlling the gnuplot data plot
!
!*********************************************************************


    if (present(style)) then

        write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
        &//'" using 1:2 with ' // trim(my_line_type1) // ' pointtype ' // &
        & style(1:2) // ' linecolor rgb ' // trim(my_color1) // ' linewidth '// trim(my_linewidth)

    else

        write ( file_unit, '(a,i2,a)' ) 'plot "' // trim (data_file_name) &
        & //'" using 1:2 with ' // trim(my_line_type1)  // ' linecolor rgb '&
        & // trim(my_color1) // ' linewidth '// trim(my_linewidth)

    end if

!*********************************************************************
!
!   Define and write the values for the value set for the control
!   variable pause for controlling the output gnuplot data plot
!
!*********************************************************************

    if (present(pause_in)) then
        if (pause_in<0.0) then
            write ( file_unit, '(a)' ) 'pause -1 "press RETURN to continue"'
        else
            write ( my_pause,'(e9.3)') pause_in
            write ( file_unit, '(a)' ) 'pause ' // trim(my_pause)

        end if

    else
        write ( file_unit, '(a)' ) 'pause 0'

    end if

!*********************************************************************
!
!   Using the command below, write 'q' to plot file telling gnuplot
!                          to quit
!
!*********************************************************************


    write ( file_unit, '(a)' ) 'q'

    close ( unit = file_unit )

!*********************************************************************
!
!   Using the call command below send the command file to gnuplot
!   telling how gnuplot should draw and set up the plot, and to
!   plot the data in the x1, y1 arrays
!
!*********************************************************************

    call run_gnuplot (command_file_name)

!*********************************************************************

    end subroutine plot_1
!
!*********************************************************************


!*********************************************************************
!*********************************************************************

    subroutine run_gnuplot(command_file_name)

!*********************************************************************
!*********************************************************************

!*********************************************************************
    implicit none
    character (len = 100) command
    character (len = *) command_file_name
    integer status
    integer system

!*********************************************************************
!
!  Issue a command to the system that will startup GNUPLOT, using
!  the file we just wrote as input.
!
!*********************************************************************

    write (command, *) 'gnuplot ' // trim (command_file_name)

    status=system(trim(command))

    if (status.ne.0) then
        print *,'RUN_GNUPLOT - Fatal error!'
        stop

    end if

    return

!*********************************************************************

    end subroutine run_gnuplot

!*********************************************************************


!***************************************************************
!***************************************************************

    subroutine get_unit(iunit)


!****************************************************************
!****************************************************************

    implicit none
    integer i
    integer ios
    integer iunit
    logical lopen

!*********************************************************************
!
!   This subroutine looks for the unit number for an unused terminal
!   which can be used to write setup, formatting, control and plot
!   information related to gnuplot drawing and plotting the input
!   data in arrays x1 and y1 as specified by the user.
!
!*********************************************************************

    iunit=0

    do i=1,99
        if (i/= 5 .and. i/=6) then
            inquire (unit=i, opened=lopen, iostat=ios)
            if (ios==0) then
                if (.not.lopen) then
                    iunit=i
                    return
                end if
            end if

        end if
    end do
    return
    end subroutine get_unit
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...