Переделать исходный код на Паскале в Фортран

@ЮлияБаля · Регистрация: 31.10.2012

Author24 — интернет-сервис помощи студентам

Pascal

Program Ex3;
 const N=5;
 const M=5;
 Var i,j:integer; A,B,x1,x2,Hx,p1,p2,Hp:real;
 x,p:array[1..N] of real;
 c:array[1..N, 1..M] of real;
 s:array[1..N, 1..M] of string;
 Np,Nx:real;
 Begin
 writeln('vvedi x1'); readln(x1);
 writeln('vvedi x2'); readln(x2);
 writeln('vvedi Hx'); readln(Hx);
 writeln('vvedi p1'); readln(p1);
 writeln('vvedi p2'); readln(p2);
 writeln('vvedi Hp'); readln(Hp);
 
 Nx:=abs((x2-x1)/Hx)+1;
 Np:=abs((p2-p1)/Hp)+1;
 
 for i:=2 to N do
 x[i]:=x[i-1]+Hx;
 for i:=2
 
 to N do
 p[i]:=p[i-1]+Hp;
 
 for i:=1 to N do
 for j:=1 to M do
 begin
 if 2*p[j]*x[i]<0 then s[i,j]:='*'
 else
 begin
 A:=sqrt(2*p[j]*x[i])+3.5*x[i]*x[i] -10;
 if A<0 then s[i,j]:='*'
 else
 begin
 if 2*p[j]-6*x[i]+1<0 then s[i,j]:='***'
 else
 begin
 B:=(sqr(cos(abs(ln(2*p[j]-6*x[i]+1)))))-1;
 if B=0 then s[i,j]:='***';
 c[i,j]:=sqrt(A)/B;
 end;
 end;
 end;
 end;
 write('x/p '); for j:=2 to M do write(p[j]:4:2, ' ');
 writeln;
 
 for i:=2 to N do begin write(x[i]:4:2, ' ');
 for j:=2 to M do write(c[i,j]:4:2, ' ');
 writeln;
 end;
 if c[i,j]=s[i,j] then writeln('*-net kornya iz otr', '**-logarifma net', '***-0 v znamentele')
 
 
 
 End.

А вот как звучало задание
Многомерные массивы.
Задачу, которая предлагается Вам, часто называют табулиро¬ванием функции, по-скольку она связана с составлением таблицы зна¬чений функции, соответствующих опре-деленным значениям аргумента.
Первая часть Вашего задания - подготовка программы, табули¬рующей функцию С(х,р) Вашего варианта при изменении значения ар¬гумента X от значения xl до значения х2 с шагом Нх и аргумента Р - от p1 до р2 с шагом Нр. Результаты напечатайте в виде таб-лицы-матрицы:
Х / Р 7.425 7.450 7.475 7.500 7.525 7.550 7.575
3.50 -.0634 * 3.581 4.145 6.524 8.745 12.659
5.00 1.487 16.832 -8.245 -5.434 * * 4.326
6.50 -5.208 ** ** 8.987 15.782 68.547 124.317

* — В знаменателе ноль
** — Под логарифмом отрицательное число

Совет:
• прежде, чем печатать результаты, наколите их в памяти, используя для этого один или несколько массивов;
• При вводе данных организуйте контроль на достоверность: при положительном шаге Нx недопустимо, чтобы xl было боль¬ше х2, а при отрицательной величине ша-га Нx нельзя задавать xl < х2 (аналогично для Нp );
• выбранные размерности массивов должны быть достаточны для хра¬нения значений X, Р и таблицы значений функции С(х,р). Поэ¬тому, если число шагов или при введенных исходных данных оказалось больше числа компонент массива в соответствующем измерении, проводить расчеты нельзя. В тех случаях, когда при вводе исходных данных (xl, х2, Нх, p1, р2, Нр) будут зафиксированы описанные (или подобные) ситуации, программа должна сообщать об этом и либо завершать работу, либо повторно запрашивать данные.
• При выполнении этой работы не забывайте, что в некоторых клетках Вашей мат-рицы рассчитать значение С(х,р) для соответствующих значений X и Р нельзя. Та-кие клетки следует заполнить знаками «*». При этом количество звездочек должно обозначать причину по которой значение функции не было рассчитано.
• После таблицы следует вывести расшифровку легенды: что обозначено тем или иным количеством звездочек.
Второй частью Вашего задания будет работа с матрицей значе¬нии функции С(х,р). Что именно требуется сделать, Вы узнаете из таблицы 3, выбрав оттуда задачу с номером Вашего варианта.

@MOHCTP · 21.03.2013, 11:19

Тут какая-то странность. Пишутся 2 вложенных цикла с действиями:
x[i]:=x[i-1]+Hx
p[i]:=p[i-1]+Hp
но при этом значения первых элементов массивов, от которых все отсчитывается, никак не определены. Принимается, что они инициализируются нулями?

@ЮлияБаля · 21.03.2013, 15:33 **[ТС]**

Да наверное. Вот смотри у меня есть рабочяя программа моя но там есть некоторые недочеты по алгоритмы( сможешь исправить ошибки? это все таже программа. просто я за сегодня ее сделала.

Fortran

Program massiv
    
    Real p(5), x(5), c 
    Character*10 S(5,5),cc
    N=5
    M=5
    write(*,*) 'vvedite x1'
    read(*,*) x1
    write(*,*) 'vvedite x2'
    read(*,*) x2
    write(*,*) 'vvedite Hx'
    read(*,*) Hx
    write(*,*) 'vvedite p1'
    read(*,*) p1
    write(*,*) 'vvedite p2'
    read(*,*) p2
    write(*,*) 'vvedite Hp'
    read(*,*) Hp
 
    Nx=abs((x2-x1)/Hx)+1;
    Np=abs((p2-p1)/Hp)+1;
 
    x(1)=x1
    p(1)=p1
    do 1,i=2,Nx
1   x(i)=x1+(i-1)*Hx
    do 2,i=2,Np
2   p(i)=p1+(i-1)*Hp
    do 3,i=1,N
    do 3,j=1,M
 
    buf1=x(i)*x(i)*x(i)-1.5
    if (buf1) 10,20,30
    
 
10  S(i,j)='*'
    write(*,*) S(i,j)
    goto 3
 
 
20  S(i,j)='***'
    write(*,*) S(i,j)
    goto 3
    
30  buf2=abs(x(i)*x(i)-(p(j)/(x(i)*x(i)-1.5)))-0.2
    
    if (buf2) 40,40,50
 
40  S(i,j)='**'
    write(*,*) S(i,j)
    goto 3
 
50  buf3=log((abs(x(i)*x(i)-(p(j)/(x(i)*x(i)-1.5)))-0.2))
 
    if (buf3) 10,60,60
    
    
60  buf4=sqrt(log((abs(x(i)*x(i)-(p(j)/(x(i)*x(i)-1.5)))-0.2)))
 
    if (buf4) 70,80,70
 
80  S(i,j)='***'
    write(*,*) S(i,j)
    goto 3
    
70  C= (p(j)*x(i)-sqrt(buf1)-sin(x(i)))/(buf4)
    write(cc,220) C
    
3   S(i,j)=cc   
200 format(4x,'x/p',5f10.2)
    write(*,200)  (p(j),j=1,M)  
        do 4, i=1,N
210 format(1x,f6.2,5a10)
4   write(*,210) x(i), (s(i,j),j=1,N)
220 format(f10.2)   
    
 
 
 
 
 
 
 
 
 
 
    write(*,2000) 
2000    format(1x,49h*-net kornya iz otr,**-logarifma net,***-0 v znam)
 
1000    end

@MOHCTP · 22.03.2013, 08:50

Кто Вас учит такому Фортрану?

Вычисляемые операторы перехода типа if (buf4) 70,80,70 давным-давно (еще со времен Фортрана-77) исключены из стандарта, поскольку могут привести к трудно отлавливаемым ошибкам.

В общем, программу я переписал на Фортран, в меру моего понимания. Раз уж на печать почти все выводится из строкового массива, то и все остальное есть смысл туда запихнуть. Но у меня есть серьезные подозрения, что эта программа не совсем корректна. Кажись, там должно вычисляться все для некоторого промежутка параметров х и р. Если так, то записано неправильно, надо исправлять. И еще: действительно ли там матрица только 5 на 5? В примере к задаче она большего размера.

Fortran

program Ex3
implicit none
 
integer, parameter :: N=5, M=5
integer :: i, j 
real :: A, B, x1, x2, Hx, p1, p2, Hp, Np, Nx
real, dimension(N) :: x, p
real, dimension(N, M) :: c
character*13, dimension(0:N, 0:M) :: s
 
write (*,*) 'BBECTu x1' 
read (*,*) x1
write (*,*) 'BBECTu x2' 
read (*,*) x2
write (*,*) 'BBECTu Hx' 
read (*,*) Hx
write (*,*) 'BBECTu p1' 
read (*,*) p1
write (*,*) 'BBECTu p2' 
read (*,*) p2
write (*,*) 'BBECTu Hp' 
read (*,*) Hp
 
Nx = abs((x2-x1)/Hx) + 1
Np = abs((p2-p1)/Hp) + 1
 
x(1) = 0.0
p(1) = 0.0
 
do i = 2,N
  x(i) = x(i-1) + Hx
end do
do j = 2,M  
  p(j) = p(j-1) + Hp
end do  
 
s(0,0) = '    X\P      '
s(0,0)(13:13) = char(179)
  
do i = 1,N
  write (s(i,0), 4) x(i)
  s(i,0)(13:13) = char(179)
  do j = 1,M
    write (s(0,j), 4) p(j)
    s(0,j)(13:13) = char(179)
    if (x(i)*p(j).lt.0.0) then
      s(i,j) = '     *       '
      s(i,j)(13:13) = char(179)
    else
        A = sqrt(2*p(j)*x(i)) + 3.5*x(i)*x(i) - 10
        if (A.lt.0.0) then
          s(i,j) = '     *       '
          s(i,j)(13:13) = char(179)  
        else
            if (2*p(j) - 6*x(i) + 1.0.lt.0.0) then
              s(i,j) = '     **      '
              s(i,j)(13:13) = char(179)  
            else
                B = sqrt(cos(abs(log(2.0*p(j) - 6*x(i) + 1)))) - 1
                if (B.eq.0.0) then
                  s(i,j) = '    ***      '
                  s(i,j)(13:13) = char(179)  
                else
                    c(i,j) = sqrt(A)/B
                    write (s(i,j), 4) c(i,j)
                    s(i,j)(13:13) = char(179)
                end if
            end if
        end if
    end if
  end do
end do               
 
do i = 0,N
  write(*,*) (s(i,j), j = 0,M)
end do
 
write (*,*) ' '
write (*,*) ' * - net kornya iz otr, ** - logarifma net, *** - delenie na 0'
 
4  format (E12.5)
 
end program

Добавлено через 38 минут
А, ну да, я невнимательно задание прочитал. Действительно, проход по параметрам с заданным шагом от одного значения до другого. Тогда начальные значения - явно не нули. Но тут некоторая малопонятная для практики вещь возникает. Допустим, задано, что мы меняем параметр в пределах от 1.0 до 1.7 с шагом 0.2, что получается? У нас будут точки со значениями 1.0, 1.2, 1.4 и 1.6, а в точку 1.7 мы не попадем. Можно оставить так, можно попытаться чуть растянуть шаг, чтобы покрывался весь интервал. Но лучше, наверно, не надо.

Другой вопрос - размерность рабочих массивов. В исходной программе она задана как 5. Мало. Думаю, на всякий случай заказать что-то порядка 50х50 не помешает. А потом использовать по мере надобности, то есть посчитать количество данных, нужных реально для работы. Автор исходной программы даже попытался это сделать: это некие Nx и Np, которые описаны у него как действительные числа, а по идее должны быть натуральными. Я бездумно переписал их вычисление на Фортран, Вы тоже. А больше нигде они не используются. А должны. Плюс к тому, сам процесс вычисления количества точек не так прост, ибо границы интервала и шаг - действительные числа, которые хранятся в памяти в приближенном виде, действия с ними дают приближенный результат, который еще тем или иным образом надо округлять до ближайшего целого числа, чтобы получить количество точек. А если интервал охватывается не весь (как в примере с 1.0-1.7 при шаге 0.2), то это тоже надо как-то учесть.

В общем, программу я кое-как переписал, но уверен, что результат преподавателя не устроит. Потихоньку буду исправлять, может, что-то и получится.

@ЮлияБаля · 22.03.2013, 17:57 **[ТС]**

Спасибо большое я сейчас ее просмотрю, а по поводу Фортрана мы и пишем на 77 Фортране поэтому нас такому и учат)на счет размерности мы решили что она просто будет стандартна 5 на 5.

@MOHCTP · 22.03.2013, 19:29

Тогда придется переделать все циклы на старые, с меткой, отступы нужные сделать. Все использование IF - THEN - ELSE вполне в рамках Фортрана-77. На Паскале это было вполне нормально написано, и на Фортран этот кусок переносится без особого труда.

@MOHCTP · 22.03.2013, 23:24

Я переписал на Фортране-77, заказал бо-ольшие исходные массивы, написал проверки, все компилируется. Но немного не работает. На скриншоте видно, что не хватает еще одного шага. Но это мелочи, надо потом чуток довести до ума.

Fortran

      program Ex3
      integer Nmax, Mmax, N, M, i, j
      parameter (Nmax = 50, Mmax = 50)
      real A, B, x1, x2, Hx, p1, p2, Hp, Np, Nx
      real x(Nmax), p(Mmax), c(Nmax, Mmax)
      character*13 s(0:Nmax, 0:Mmax)
 
100   write (*,*) 'BBECTu x1' 
      read (*,*) x1
      write (*,*) 'BBECTu x2' 
      read (*,*) x2
      write (*,*) 'BBECTu Hx' 
      read (*,*) Hx
      write (*,*) 'BBECTu p1' 
      read (*,*) p1
      write (*,*) 'BBECTu p2' 
      read (*,*) p2
      write (*,*) 'BBECTu Hp' 
      read (*,*) Hp
      if ((x2-x1)*Hx.le.0.0 .or. (p2-p1)*Hp.le.0.0) then
        write (*,*) 'Oshibka vvoda dannyh:' 
        write (*,*) 'shag parametra imeet nepravilniy znak.'
        write (*,*) 'Povtorite vvod dannyh'
        go to 100
      end if
        Nx = (x2-x1)/Hx 
        Np = (p2-p1)/Hp   
        if (Nx.gt.Nmax-1 .or. Np.gt.Mmax-1) then
          write (*,*) 'Oshibka vvoda dannyh:' 
          write (*,*) 'chislo tochek prevyshaet dopustimoe.'
          write (*,*) 'Povtorite vvod dannyh'
          go to 100
        end if
 
      N = nint(Nx) + 1
      if (real(N)-Nx.gt.0.001) N = N - 1
C  Poslednyaya tochka vyhodit za predely intervala, ona otbrasyvaetsya              
      M = nint(Np) + 1
      if (real(M)-Np.gt.0.001) M = M - 1  
 
        x(1) = x1
        p(1) = p1
      do 1, i = 2,N
        x(i) = x(i-1) + Hx
  1   continue
      do 2, j = 2,M  
        p(j) = p(j-1) + Hp
  2   continue
  
      s(0,0) = '    X\P      '
      s(0,0)(13:13) = char(179)  
      do 3, i = 1,N
        write (s(i,0), 40) x(i)
        s(i,0)(13:13) = char(179)
  3   continue   
      do 4, j = 1,M
        write (s(0,j), 40) p(j)
        s(0,j)(13:13) = char(179)
  4   continue
 
      do 10, i = 1,N
        do 11, j = 1,M
          if (x(i)*p(j).lt.0.0) then
             s(i,j) = '     *       '
             s(i,j)(13:13) = char(179)
          else
             A = sqrt(2*p(j)*x(i)) + 3.5*x(i)*x(i) - 10
             if (A.lt.0.0) then
                s(i,j) = '     *       '
                s(i,j)(13:13) = char(179)  
             else
                if (2*p(j) - 6*x(i) + 1.0.lt.0.0) then
                   s(i,j) = '     **      '
                   s(i,j)(13:13) = char(179)  
                else
                   B = sqrt(cos(abs(log(2.0*p(j) - 6*x(i) + 1)))) - 1
                   if (B.eq.0.0) then
                      s(i,j) = '    ***      '
                      s(i,j)(13:13) = char(179)  
                   else
                      c(i,j) = sqrt(A)/B
                      write (s(i,j), 40) c(i,j)
                      s(i,j)(13:13) = char(179)
                   end if
                end if
             end if
          end if
 11     continue
 10   continue 
          
      do 12, i = 0,N
        write(*,*) (s(i,j), j = 0,M)
 12   continue
      write (*,*) ' '
      write (*,*) ' *-net SQRT (<0), **-logarifma net, ***-delenie na 0'
 
 40   format (E12.5)
      pause
      end program

@MOHCTP · 23.03.2013, 09:40

Косяк на счет урезания границ понял: 36 и 39 строчки с ошибкой. Должно быть:

if (real(N-1)-Nx.gt.0.001) N = N - 1
if (real(M-1)-Np.gt.0.001) M = M - 1

Но все равно несколько изумляет хроническое отсутствие чисел в результате. Вы не проверяли условия существования этих функций, хоть где-то они выполняются?

@ЮлияБаля · 23.03.2013, 09:54 **[ТС]**

Конечно выполняются. Там наоборот меньше случаев когда должны быть *

@MOHCTP 294 / 206 / 2 Регистрация: 20.02.2011 Сообщений: 551
	21.03.2013, 11:19	2
	Тут какая-то странность. Пишутся 2 вложенных цикла с действиями: x[i]:=x[i-1]+Hx p[i]:=p[i-1]+Hp но при этом значения первых элементов массивов, от которых все отсчитывается, никак не определены. Принимается, что они инициализируются нулями? 0

@ЮлияБаля 0 / 0 / 0 Регистрация: 31.10.2012 Сообщений: 9
	22.03.2013, 17:57 [ТС]	5
	Спасибо большое я сейчас ее просмотрю, а по поводу Фортрана мы и пишем на 77 Фортране поэтому нас такому и учат)на счет размерности мы решили что она просто будет стандартна 5 на 5. 0

@MOHCTP 294 / 206 / 2 Регистрация: 20.02.2011 Сообщений: 551
	22.03.2013, 19:29	6
	Тогда придется переделать все циклы на старые, с меткой, отступы нужные сделать. Все использование IF - THEN - ELSE вполне в рамках Фортрана-77. На Паскале это было вполне нормально написано, и на Фортран этот кусок переносится без особого труда. 0

@MOHCTP 294 / 206 / 2 Регистрация: 20.02.2011 Сообщений: 551
	23.03.2013, 09:40	8
	Косяк на счет урезания границ понял: 36 и 39 строчки с ошибкой. Должно быть: if (real(N-1)-Nx.gt.0.001) N = N - 1 if (real(M-1)-Np.gt.0.001) M = M - 1 Но все равно несколько изумляет хроническое отсутствие чисел в результате. Вы не проверяли условия существования этих функций, хоть где-то они выполняются? 0

@ЮлияБаля 0 / 0 / 0 Регистрация: 31.10.2012 Сообщений: 9
	23.03.2013, 09:54 [ТС]	9
	Конечно выполняются. Там наоборот меньше случаев когда должны быть * 0