DIMENSION A(10),B(4,10),C(4)
INTEGER K,I;
C(1)=5
C(2)=3
C(3)=1
C(4)=8
PRINT *,'ishodnii massiv A'
DO K=1,10
A(K)=K
PRINT *,K
END DO
DO I=1,4
DO K=1,10
IF (K<11-C(I)) THEN
B(I,K)=A(K+C(I))
ELSE
B(I,K)=A(K+C(I)-10)
END IF
END DO
END DO
PRINT *,'massiv B'
DO I=1,4
PRINT *,I
DO K=1,10
PRINT *,B(I,K)
END DO
END DO
END
(Fortran) Создание процедур
имеется небольшая программка, по перестановке чисел в массиве.
Подскажите пожалуйста на какие моменты в программе можно сделать процедуры(подпрограммы), т.е. "call sub... subroutine sub...end subroutine"
и какие параметры указывать в них.
Пытался сделать процедуру на этот кусок
но при расчетах, указывал передачу результатов по (K,I) и результат выводился в неверных значениях.
Помогите пожалуйста. Буду очень благодарен.
Код:
Подскажите пожалуйста на какие моменты в программе можно сделать процедуры(подпрограммы), т.е. "call sub... subroutine sub...end subroutine"
и какие параметры указывать в них.
Пытался сделать процедуру на этот кусок
Код:
DO I=1,4
DO K=1,10
IF (K<11-C(I)) THEN
B(I,K)=A(K+C(I))
ELSE
B(I,K)=A(K+C(I)-10)
END IF
END DO
END DO
DO K=1,10
IF (K<11-C(I)) THEN
B(I,K)=A(K+C(I))
ELSE
B(I,K)=A(K+C(I)-10)
END IF
END DO
END DO
но при расчетах, указывал передачу результатов по (K,I) и результат выводился в неверных значениях.
Помогите пожалуйста. Буду очень благодарен.
к примеру можно сделать так:
Код:
DIMENSION A(10),B(4,10),C(4)
INTEGER K,I;
C(1)=5
C(2)=3
C(3)=1
C(4)=8
PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
DIMENSION S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
PRINT *,B(J,K)
END DO
PRINT *,'======='
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
DIMENSION S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
DIMENSION S1(N),S2(N),S3(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
IF (K<11-S2(J)) THEN
S3(J,K)=S1(K+S2(J))
ELSE
S3(J,K)=S1(K+S2(J)-10)
END IF
END DO
END DO
END SUBROUTINE MODMAS
END
INTEGER K,I;
C(1)=5
C(2)=3
C(3)=1
C(4)=8
PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
DIMENSION S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
PRINT *,B(J,K)
END DO
PRINT *,'======='
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
DIMENSION S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
DIMENSION S1(N),S2(N),S3(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
IF (K<11-S2(J)) THEN
S3(J,K)=S1(K+S2(J))
ELSE
S3(J,K)=S1(K+S2(J)-10)
END IF
END DO
END DO
END SUBROUTINE MODMAS
END
при выполнении выходит ошибка по поводу переполнения.
Дебагер указывает на строку "S3(J,K)=S1(K+S2(J))". Как можно исправить?!
Дебагер указывает на строку "S3(J,K)=S1(K+S2(J))". Как можно исправить?!
у меня все нормал (Compaq Visual Fortran Optimizing Compiler v6.1).
отыскал Intel Fortran Compiler 4.5 попробовал на нем выдает на строках
варнинги, но экзешку делает и переполнения никакого нет.
Код:
S3(J,K)=S1(K+S2(J))
...........................
S3(J,K)=S1(K+S2(J)-10)
...........................
S3(J,K)=S1(K+S2(J)-10)
варнинги, но экзешку делает и переполнения никакого нет.
ну а введение каких-либо ограничений по If не поможет?
Просто по сути если идет переполенение, т.е. значение K больше 11, программа должна идти по второй ветке, с вычитанием 10, но этого же не происходит.
Просто по сути если идет переполенение, т.е. значение K больше 11, программа должна идти по второй ветке, с вычитанием 10, но этого же не происходит.
[quote=o1ps]ну а введение каких-либо ограничений по If не поможет?
Просто по сути если идет переполенение, т.е. значение K больше 11, программа должна идти по второй ветке, с вычитанием 10, но этого же не происходит.[/quote]
значение K по коду больше 11 никогда не будет и равно 11 тоже.
попробуй так(у меня варнинги, при этом коде, не выдает, так что может сработает и у тебя):
Просто по сути если идет переполенение, т.е. значение K больше 11, программа должна идти по второй ветке, с вычитанием 10, но этого же не происходит.[/quote]
значение K по коду больше 11 никогда не будет и равно 11 тоже.
попробуй так(у меня варнинги, при этом коде, не выдает, так что может сработает и у тебя):
Код:
DIMENSION A(10),B(4,10),C(4)
INTEGER K,I;
C(1)=5
C(2)=3
C(3)=1
C(4)=8
PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
DIMENSION S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
PRINT *,B(J,K)
END DO
PRINT *,'======='
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
DIMENSION S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
DIMENSION S1(N),S2(N),S3(N,M)
INTEGER J,Z,K
DO J=1,N
DO Z=1,M
IF (Z<11-S2(J)) THEN
K=Z+S2(J)
S3(J,Z)=S1(K)
ELSE
K=Z+S2(J)-10
S3(J,Z)=S1(K)
END IF
END DO
END DO
END SUBROUTINE MODMAS
END
INTEGER K,I;
C(1)=5
C(2)=3
C(3)=1
C(4)=8
PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
DIMENSION S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
PRINT *,B(J,K)
END DO
PRINT *,'======='
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
DIMENSION S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
DIMENSION S1(N),S2(N),S3(N,M)
INTEGER J,Z,K
DO J=1,N
DO Z=1,M
IF (Z<11-S2(J)) THEN
K=Z+S2(J)
S3(J,Z)=S1(K)
ELSE
K=Z+S2(J)-10
S3(J,Z)=S1(K)
END IF
END DO
END DO
END SUBROUTINE MODMAS
END
При смене S1 на M программа выполняется. В этом была проблема?!
А можно еще поинтересоваться, как выводить полученный массив B не весь в столбец, а в 4 столбца?!
[quote=o1ps]При смене S1 на M программа выполняется. В этом была проблема?![/quote]
хм... странно, повторюсь у меня и так все нормал. ты что используешь, какой компилер?
[quote=o1ps]А можно еще поинтересоваться, как выводить полученный массив B не весь в столбец, а в 4 столбца?![/quote]
попробуй так:
хм... странно, повторюсь у меня и так все нормал. ты что используешь, какой компилер?
[quote=o1ps]А можно еще поинтересоваться, как выводить полученный массив B не весь в столбец, а в 4 столбца?![/quote]
попробуй так:
Код:
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO K=1,M
PRINT *,(B(J,K),J=1,N)
END DO
END SUBROUTINE PRINTMAS_2
DIMENSION S(N,M)
INTEGER J,K
DO K=1,M
PRINT *,(B(J,K),J=1,N)
END DO
END SUBROUTINE PRINTMAS_2
А если необходим вывод массива по формату, как целое число без дробной части?
[quote=o1ps]А если необходим вывод массива по формату, как целое число без дробной части?[/quote]
можно просто заменить DIMENSION на INTEGER. а вообще, если требуется форматный вывод то уже нужно использовать не PRINT, а WRITE с параметрами формата.
можно просто заменить DIMENSION на INTEGER. а вообще, если требуется форматный вывод то уже нужно использовать не PRINT, а WRITE с параметрами формата.
Встала непростая задача, связанная с этой програмкой. Если вас не затруднит, помогите пожалуйста.
Есть необходимость при опросе провести перестановку массива, взятого из файла.
Корпел над кодом, но не вышло. Создал отдельную процедуру:
а затем в программе хотел при запросе либо просто проводить перестановку уже заданного массива, либо массива взятого из файла
- выдается только первая строка, остальные идут символами.. Помогите пожалуйста исправить.
Есть необходимость при опросе провести перестановку массива, взятого из файла.
Корпел над кодом, но не вышло. Создал отдельную процедуру:
Код:
subroutine opedfile
integer n,m
dimension q(10)
!open (1,file='FIRST.txt')
open (1,file='SECOND.txt')
read(1,*) q
print*,q
rewind(1)
end subroutine opedfile
integer n,m
dimension q(10)
!open (1,file='FIRST.txt')
open (1,file='SECOND.txt')
read(1,*) q
print*,q
rewind(1)
end subroutine opedfile
а затем в программе хотел при запросе либо просто проводить перестановку уже заданного массива, либо массива взятого из файла
Код:
call opedfile
do i=1,10
write(*,*)q(i)
end do
do i=1,10
write(*,*)q(i)
end do
- выдается только первая строка, остальные идут символами.. Помогите пожалуйста исправить.
так, вот процедура для считывания значений из файла:
использовать так:
Код:
SUBROUTINE READFILETOMAS(MAS,N)
INTEGER MAS(N)
OPEN(1,FILE='SECOND.txt')
READ (1,*) MAS
REWIND(1)
CLOSE(1)
END SUBROUTINE READFILETOMAS
INTEGER MAS(N)
OPEN(1,FILE='SECOND.txt')
READ (1,*) MAS
REWIND(1)
CLOSE(1)
END SUBROUTINE READFILETOMAS
использовать так:
Код:
INTEGER Q(10)
....................
CALL READFILETOMAS(Q,10)
DO K=1,10
WRITE (*,*)Q(K)
END DO
....................
CALL READFILETOMAS(Q,10)
DO K=1,10
WRITE (*,*)Q(K)
END DO
Вот грубо весь код:
но при нажатии "2",т.е. выбор перестановки из файла ответ выводиться стандартная перестановка от 1 до 10. в Фаиле содежатьс всевозможные значения от 1 до 10 но не по порядку. В Чем может быть проблема?
Код:
DIMENSION A(10),B(4,10),C(4)
INTEGER K,I;
INTEGER Q(10)
character(20),parameter ::it='programming of white industries'
character(30),parameter ::st1='Do you want to repeat?(y/n)'
character(40),parameter ::st2='Gelajete isprobovat programmy?(y\n)'
C(1)=5
C(2)=3
C(3)=1
C(4)=8
6 print *,'Vivesti standartniy massiv ili iz faila?(1/2)'
read *,Y
if (y.eq.1) then
goto 8
else
if (y.eq.2) then
CALL READFILETOMAS(Q,10)
DO K=1,10
WRITE (*,*)Q(K)
END DO
CALL MODMAS(A,C,B,4,10)
end if
end if
!select case (Y)
!case('1')
!go to 8
!case ('2')
!go to 7
!end select
!go to 6
8 PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
DIMENSION S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO K=1,M
PRINT *,(B(J,K),J=1,N)
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
DIMENSION S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
DIMENSION S1(M),S2(N),S3(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
IF (K<11-S2(J)) THEN
S3(J,K)=S1(K+S2(J))
ELSE
S3(J,K)=S1(K+S2(J)-10)
END IF
END DO
END DO
END SUBROUTINE MODMAS
SUBROUTINE READFILETOMAS(MAS,N)
INTEGER MAS(N)
OPEN(1,FILE='SECOND.txt')
READ (1,*) MAS
REWIND(1)
CLOSE(1)
END SUBROUTINE READFILETOMAS
END
INTEGER K,I;
INTEGER Q(10)
character(20),parameter ::it='programming of white industries'
character(30),parameter ::st1='Do you want to repeat?(y/n)'
character(40),parameter ::st2='Gelajete isprobovat programmy?(y\n)'
C(1)=5
C(2)=3
C(3)=1
C(4)=8
6 print *,'Vivesti standartniy massiv ili iz faila?(1/2)'
read *,Y
if (y.eq.1) then
goto 8
else
if (y.eq.2) then
CALL READFILETOMAS(Q,10)
DO K=1,10
WRITE (*,*)Q(K)
END DO
CALL MODMAS(A,C,B,4,10)
end if
end if
!select case (Y)
!case('1')
!go to 8
!case ('2')
!go to 7
!end select
!go to 6
8 PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
DIMENSION S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
DIMENSION S(N,M)
INTEGER J,K
DO K=1,M
PRINT *,(B(J,K),J=1,N)
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
DIMENSION S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
DIMENSION S1(M),S2(N),S3(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
IF (K<11-S2(J)) THEN
S3(J,K)=S1(K+S2(J))
ELSE
S3(J,K)=S1(K+S2(J)-10)
END IF
END DO
END DO
END SUBROUTINE MODMAS
SUBROUTINE READFILETOMAS(MAS,N)
INTEGER MAS(N)
OPEN(1,FILE='SECOND.txt')
READ (1,*) MAS
REWIND(1)
CLOSE(1)
END SUBROUTINE READFILETOMAS
END
но при нажатии "2",т.е. выбор перестановки из файла ответ выводиться стандартная перестановка от 1 до 10. в Фаиле содежатьс всевозможные значения от 1 до 10 но не по порядку. В Чем может быть проблема?
может так(я предполагаю, что над массивом считанным из файла тоже нужно провести те же действия, что и над стандартным):
кстати зачем тебе GOTO можно было просто в if then else endif поместить нужный код. обрати внимание на STOP, он нужен для того, чтобы программа прерывалась после отработки пункта 2(а то потом и действия соответствующие пункту 1 выполняться будут) или выбора значения не равного ни 1 ни 2. вообщем смотри сам, что тебе нужно.
Код:
INTEGER A(10),B(4,10),C(4)
INTEGER K,I;
INTEGER Q(10)
character(20),parameter ::it='programming of white industries'
character(30),parameter ::st1='Do you want to repeat?(y/n)'
character(40),parameter ::st2='Gelajete isprobovat programmy?(y\n)'
C(1)=5
C(2)=3
C(3)=1
C(4)=8
6 print *,'Vivesti standartniy massiv ili iz faila?(1/2)'
read *,Y
if (y.eq.1) then
goto 8
else
if (y.eq.2) then
CALL READFILETOMAS(Q,10)
CALL PRINTMAS_1(Q, 10)
CALL MODMAS(Q,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
end if
end if
STOP
!select case (Y)
!case('1')
!go to 8
!case ('2')
!go to 7
!end select
!go to 6
8 PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
INTEGER S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
INTEGER S(N,M)
INTEGER J,K
DO K=1,M
PRINT *,(B(J,K),J=1,N)
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
INTEGER S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
INTEGER S1(M),S2(N),S3(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
IF (K<11-S2(J)) THEN
S3(J,K)=S1(K+S2(J))
ELSE
S3(J,K)=S1(K+S2(J)-10)
END IF
END DO
END DO
END SUBROUTINE MODMAS
SUBROUTINE READFILETOMAS(MAS,N)
INTEGER MAS(N)
OPEN(1,FILE='SECOND.txt')
READ (1,*) MAS
REWIND(1)
CLOSE(1)
END SUBROUTINE READFILETOMAS
END
INTEGER K,I;
INTEGER Q(10)
character(20),parameter ::it='programming of white industries'
character(30),parameter ::st1='Do you want to repeat?(y/n)'
character(40),parameter ::st2='Gelajete isprobovat programmy?(y\n)'
C(1)=5
C(2)=3
C(3)=1
C(4)=8
6 print *,'Vivesti standartniy massiv ili iz faila?(1/2)'
read *,Y
if (y.eq.1) then
goto 8
else
if (y.eq.2) then
CALL READFILETOMAS(Q,10)
CALL PRINTMAS_1(Q, 10)
CALL MODMAS(Q,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
end if
end if
STOP
!select case (Y)
!case('1')
!go to 8
!case ('2')
!go to 7
!end select
!go to 6
8 PRINT *,'ishodnii massiv A'
CALL CREATEA(A,10)
CALL PRINTMAS_1(A, 10)
CALL MODMAS(A,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
CONTAINS
SUBROUTINE CREATEA(S,N)
INTEGER S(N)
INTEGER K
DO K=1,N
S(K)=K
END DO
END SUBROUTINE CREATEA
SUBROUTINE PRINTMAS_2(S, N, M)
INTEGER S(N,M)
INTEGER J,K
DO K=1,M
PRINT *,(B(J,K),J=1,N)
END DO
END SUBROUTINE PRINTMAS_2
SUBROUTINE PRINTMAS_1(S, N)
INTEGER S(N)
INTEGER J
DO J=1,N
PRINT *,S(J)
END DO
END SUBROUTINE PRINTMAS_1
SUBROUTINE MODMAS(S1,S2,S3,N,M)
INTEGER S1(M),S2(N),S3(N,M)
INTEGER J,K
DO J=1,N
DO K=1,M
IF (K<11-S2(J)) THEN
S3(J,K)=S1(K+S2(J))
ELSE
S3(J,K)=S1(K+S2(J)-10)
END IF
END DO
END DO
END SUBROUTINE MODMAS
SUBROUTINE READFILETOMAS(MAS,N)
INTEGER MAS(N)
OPEN(1,FILE='SECOND.txt')
READ (1,*) MAS
REWIND(1)
CLOSE(1)
END SUBROUTINE READFILETOMAS
END
кстати зачем тебе GOTO можно было просто в if then else endif поместить нужный код. обрати внимание на STOP, он нужен для того, чтобы программа прерывалась после отработки пункта 2(а то потом и действия соответствующие пункту 1 выполняться будут) или выбора значения не равного ни 1 ни 2. вообщем смотри сам, что тебе нужно.
Спасибо огромное, совсем запамятовал насчет stop..
А если как вариант пользователь захочет ввести массив с клавиатуры, то подойдет ли такой вариант:
ну а далее ссылка на уже знакомые процедуры?
А если как вариант пользователь захочет ввести массив с клавиатуры, то подойдет ли такой вариант:
Код:
real, allocatable :: x(:)
............
allocate (x(k))
print*, "Input massiv"
read*, x
....
............
allocate (x(k))
print*, "Input massiv"
read*, x
....
ну а далее ссылка на уже знакомые процедуры?
подойдет, почему нет? только обрати внимание на то какой тип данных у элементов массива и какой понимают процедуры, т.е. если в процедуру в качестве параметра бросаешь массив из действительных чисел, то и в процедуре ему должен соответствовать нужный тип данных и т.д. кстати еще до того как вызвать allocate определись со значением k.
ну К задать как J
я имел ввиду численной значение, т.е. например:
если K(или любой другой переменной используемой в данной конструкции) не будет присвоено никакого значения до вызова ALLOCATE, то вероятнее всего массив будет признан массивом единичной длины или что-то в этом роде. думаю разберешься что к чему.
Код:
K=10
ALLOCATE(X(K))
ALLOCATE(X(K))
если K(или любой другой переменной используемой в данной конструкции) не будет присвоено никакого значения до вызова ALLOCATE, то вероятнее всего массив будет признан массивом единичной длины или что-то в этом роде. думаю разберешься что к чему.
Код:
real, allocatable :: x(:)
.........
if (y.eq.3) then !запрос на нужное действие(на ввод с клавиатуры)
k=10
allocate (x(k))
print*, "Input massiv"
read*, x
CALL PRINTMAS_1(Q, 10)
CALL MODMAS(Q,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
....
.........
if (y.eq.3) then !запрос на нужное действие(на ввод с клавиатуры)
k=10
allocate (x(k))
print*, "Input massiv"
read*, x
CALL PRINTMAS_1(Q, 10)
CALL MODMAS(Q,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
....
сменил при вызове процедуры Q на x =) жаль что сразу не сообразил.
*******************
подскажи пожалуйста как сделать, чтобы при отсутствии файла с массивом он автоматически создавался, и массив в него заносился вручную. Если он уже создан, то перестановка происходила как обычно.
создавался через параметры файла, при его открытии...
[quote=o1ps]сменил при вызове процедуры Q на x =) жаль что сразу не сообразил.[/quote]
я тебе это в каком-то из приведенных мной фрагментов кода показывал, что надо сделать замену.
[quote=o1ps]подскажи пожалуйста как сделать, чтобы при отсутствии файла с массивом он автоматически создавался, и массив в него заносился вручную. Если он уже создан, то перестановка происходила как обычно.[/quote]
ну, так делаешь проверку на то, есть файл или нет. допустим надо проверить есть ли такой файл '1.txt', тогда пишешь так:
я тебе это в каком-то из приведенных мной фрагментов кода показывал, что надо сделать замену.
[quote=o1ps]подскажи пожалуйста как сделать, чтобы при отсутствии файла с массивом он автоматически создавался, и массив в него заносился вручную. Если он уже создан, то перестановка происходила как обычно.[/quote]
ну, так делаешь проверку на то, есть файл или нет. допустим надо проверить есть ли такой файл '1.txt', тогда пишешь так:
Код:
OPEN(1,ERR=777, STATUS='OLD', FILE='1.txt')
!если файл существует, то работаешь с ним как обычно, выполняются операторы идущие за OPEN
!если файл не существует, то выполнение передается на оператор имеющий метку 777
777 OPEN(1,STATUS='NEW',FILE='1.txt') !создаешь новый файл 1.txt
!и осуществляешь с ним нужные действия
!если файл существует, то работаешь с ним как обычно, выполняются операторы идущие за OPEN
!если файл не существует, то выполнение передается на оператор имеющий метку 777
777 OPEN(1,STATUS='NEW',FILE='1.txt') !создаешь новый файл 1.txt
!и осуществляешь с ним нужные действия
Недопонял, как организовать проверку на наличие файла и после подтверждения о его отсутсвии дальнейших действий. (насчет "действий" все ясно, но как организовать строгий цикл проверки?)
вот тебе примерчик:
внимательно посмотри как он работает. при отсутствии файла программка будет писать, что файла нет и создаст его, а если файл есть то напишет, что все готово.
Код:
OPEN(1,ERR=777,STATUS='OLD',FILE='sample.txt')
PRINT *,'FILE IS READY YOU CAN WORK'
CLOSE(1)
STOP
777 PRINT *,'FILE IS NOT READY YOU CAN NOT WORK'
PRINT *,'CREATE FILE'
OPEN(1,STATUS='NEW',FILE='sample.txt')
CLOSE(1)
END
PRINT *,'FILE IS READY YOU CAN WORK'
CLOSE(1)
STOP
777 PRINT *,'FILE IS NOT READY YOU CAN NOT WORK'
PRINT *,'CREATE FILE'
OPEN(1,STATUS='NEW',FILE='sample.txt')
CLOSE(1)
END
внимательно посмотри как он работает. при отсутствии файла программка будет писать, что файла нет и создаст его, а если файл есть то напишет, что все готово.
т.е. можно перед END воткнуть цикл ввода массива?
Код:
k=10
allocate (x(k))
print*, "Input massiv"
read*, x
CALL PRINTMAS_1(X, 10)
CALL MODMAS(X,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
........
! Запрос на разрешение создать файл
Print*, 'Do you want zapisat'' resultats v File?(''y'' if yes or any key if no.)'
read(*,*) otto
if (otto.eq.'y') then
Print *, 'Enter filename(do 30 simvoliv):' !Запрос на ввод именни файла
read(*,*) namefile
open(10,file=namefile) !Запись результата в файл
do x=1,4
write(10,'(i3,a1,$)') x,')'
do y=1,10
write(10,'(f9.2,$)') l(x,y)
enddo
write(10,*)
enddo
endfile 10
allocate (x(k))
print*, "Input massiv"
read*, x
CALL PRINTMAS_1(X, 10)
CALL MODMAS(X,C,B,4,10)
PRINT *,'massiv B'
CALL PRINTMAS_2(B,4,10)
........
! Запрос на разрешение создать файл
Print*, 'Do you want zapisat'' resultats v File?(''y'' if yes or any key if no.)'
read(*,*) otto
if (otto.eq.'y') then
Print *, 'Enter filename(do 30 simvoliv):' !Запрос на ввод именни файла
read(*,*) namefile
open(10,file=namefile) !Запись результата в файл
do x=1,4
write(10,'(i3,a1,$)') x,')'
do y=1,10
write(10,'(f9.2,$)') l(x,y)
enddo
write(10,*)
enddo
endfile 10
[quote=o1ps]т.е. можно перед END воткнуть цикл ввода массива?[/quote]
сам погляди(да вроде можно), не получится, спросишь - разберемся.
сам погляди(да вроде можно), не получится, спросишь - разберемся.
o1ps, [COLOR=red]в правилах форума конкретно написано, что для каждого нового вопроса создается новая тема со смысловым названием, а не таким как вы дали топику. в правилах приведены примеры. пожалуйста почитайте и исправьтесь.[/COLOR]
Если вы не заметили мадамм, обсуждение ведется, затрагивая только одну программу, и лчно мне бессмысленно создавать темы на общие вопросы, а важно получить ответ по исправленному коду, ориентируясь только этой программой.
если вам, сэр, нету смысла соблюдать правила форума, тогда просто неочем с вами говорить. в следущий раз я буду удалять ваши темы, и если это будет регулярно - пойдете отдыхать в бан. [COLOR=red]тема закрыта. жалобы администратору.[/COLOR]
[COLOR=black]а насчет одной программы, думаю что проблем бы не было, если бы тема была правильно названа. ваш вопрос перенесен сюда.[/COLOR]
[COLOR=black]а насчет одной программы, думаю что проблем бы не было, если бы тема была правильно названа. ваш вопрос перенесен сюда.[/COLOR]