Форум программистов, компьютерный форум, киберфорум
Наши страницы
Fortran
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.83/6: Рейтинг темы: голосов - 6, средняя оценка - 4.83
ЮлияБаля
0 / 0 / 0
Регистрация: 31.10.2012
Сообщений: 9
#1

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

20.03.2013, 21:50. Просмотров 1119. Ответов 8
Метки нет (Все метки)

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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, выбрав оттуда задачу с номером Вашего варианта.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
20.03.2013, 21:50
Ответы с готовыми решениями:

Переделать исходный код Паскаль -> Фортран
{$S+,R+} program arab_to_roman; uses crt; var n : word; ch :...

Переделать из Паскаля в фортран 77
type arr = array of integer; var a:array of integer; n, m, i, p, j, max,...

Каким образом можно перевести код Паскаля в код Фортран?
Здравствуйте уважаемые программисты! Может быть банальная, но довольно сложная...

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

К сможет перевести простой код с Паскаля на Фортран?
С Фортрана на Паскаль можно конвертировать с помощью разных программ а обратной...

8
MOHCTP
292 / 204 / 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
21.03.2013, 15:33  [ТС] #3
Да наверное. Вот смотри у меня есть рабочяя программа моя но там есть некоторые недочеты по алгоритмы( сможешь исправить ошибки? это все таже программа. просто я за сегодня ее сделала.
Fortran
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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
0
MOHCTP
292 / 204 / 2
Регистрация: 20.02.2011
Сообщений: 551
22.03.2013, 08:50 #4
Кто Вас учит такому Фортрану? Вычисляемые операторы перехода типа if (buf4) 70,80,70 давным-давно (еще со времен Фортрана-77) исключены из стандарта, поскольку могут привести к трудно отлавливаемым ошибкам.

В общем, программу я переписал на Фортран, в меру моего понимания. Раз уж на печать почти все выводится из строкового массива, то и все остальное есть смысл туда запихнуть. Но у меня есть серьезные подозрения, что эта программа не совсем корректна. Кажись, там должно вычисляться все для некоторого промежутка параметров х и р. Если так, то записано неправильно, надо исправлять. И еще: действительно ли там матрица только 5 на 5? В примере к задаче она большего размера.
Fortran
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
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), то это тоже надо как-то учесть.

В общем, программу я кое-как переписал, но уверен, что результат преподавателя не устроит. Потихоньку буду исправлять, может, что-то и получится.
0
ЮлияБаля
0 / 0 / 0
Регистрация: 31.10.2012
Сообщений: 9
22.03.2013, 17:57  [ТС] #5
Спасибо большое я сейчас ее просмотрю, а по поводу Фортрана мы и пишем на 77 Фортране поэтому нас такому и учат)на счет размерности мы решили что она просто будет стандартна 5 на 5.
0
MOHCTP
292 / 204 / 2
Регистрация: 20.02.2011
Сообщений: 551
22.03.2013, 19:29 #6
Тогда придется переделать все циклы на старые, с меткой, отступы нужные сделать. Все использование IF - THEN - ELSE вполне в рамках Фортрана-77. На Паскале это было вполне нормально написано, и на Фортран этот кусок переносится без особого труда.
0
MOHCTP
292 / 204 / 2
Регистрация: 20.02.2011
Сообщений: 551
22.03.2013, 23:24 #7
Я переписал на Фортране-77, заказал бо-ольшие исходные массивы, написал проверки, все компилируется. Но немного не работает. На скриншоте видно, что не хватает еще одного шага. Но это мелочи, надо потом чуток довести до ума.
Fortran
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
      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
0
Миниатюры
Переделать исходный код на Паскале в Фортран  
MOHCTP
292 / 204 / 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
23.03.2013, 09:54
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
23.03.2013, 09:54

Переделать исходный код. Код в Паскале,а нужно сделать его в Фортране
{$S+,R+} program arab_to_roman; uses crt; var n : word; ch :...

Переделать исходный код с Си++ на Си
#include &lt;iostream&gt; #include&lt;conio.h&gt; int main() { setlocale(LC_ALL,...

Как узнать исходный код метода из dll через код C#?
Как узнать исходный код метода из dll через код C#? помогите, пожалуйста!!...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru