program ciag
implicit none
integer::a,b,c
write(*,*)'Podaj zakres'
read(*,*) c
b=0
do a=1,c,6
b=b+a
end do
write(*,*)'Suma ciagu wynosi',b
stop
end program ciag
program ciag
implicit none
integer::a
do a=2,30,2
write(*,*)a
end do
stop
end program ciag
program ciag3
implicit none
integer::a,b,c
character(len=1)::d
1 write(*,*)'Podaj pierwsza liczbe'
read(*,*)a
write(*,*)'Podaj druga liczbe'
read(*,*)b
write(*,*)'Wcisnij + jesli chcesz dodac liczby'
write(*,*)'Wcisnij - jesli chcesz odjac liczby'
write(*,*)'Wcisnij * jesli chcesz pomnozycliczby'
write(*,*)'Wcisnij : jesli chcesz podzielic liczby'
read(*,*)d
select case (d)
case('+')
c=a+b
write(*,*)'Wynik dodawania wynosi',c
case('-')
c=a-b
write(*,*)'Wynik odejmowania wynosi',c
case('*')
c=a*b
write(*,*)'Wynik mnozenia wynosi',c
case(':')
c=a/b
write(*,*)'Wynik dzielenia wynosi',c
end select
go to 1
stop
end program ciag3
program macierz2
implicit none
real,allocatable::a(:,:),c(:,:)
integer::e,d,n,m
real::z
write(*,*)'Podaj liczbe wierszy'
read(*,*)m
write(*,*)'Podaj liczbe kolumn'
read(*,*)n
allocate(a(m,n),c(m,n))
do d=1,m
do e=1,n
write(*,*)'Podaj wartosc elementu A',d,e
read(*,*)z
a(d,e)=z
end do
end do
do d=1,m
write(*,*)a(d,:)
end do
c=5*a
write(*,*)'------------------------------------------------------'
do d=1,m
write(*,*)c(d,:)
end do
stop
end program macierz2
Program ko
implicit none
character(len=7)::f
real::r,b,p1,p2
write(*,*)'Wpisz kolo jesli chcesz liczyc pole kola'
write(*,*)'Wpisz kwadrat jesli chcesz liczysz pole kwadratu'
read(*,*)f
select case (f)
case('kolo')
write(*,*)'Podaj promien r'
read(*,*)r
call pole_kola(r,p1)
write(*,*)'Pole kola wynosi:',p1
case('kwadrat')
write(*,*)'Podaj bok kwadratu'
read(*,*)b
call pole_kw(b,p2)
write(*,*)'Pole kwadratu wynosi:',p2
end select
stop
contains
subroutine pole_kola(r,p1)
implicit none
real,intent(in)::r
real,intent(out)::p1
p1=3.14*r**2
return
end subroutine pole_kola
subroutine pole_kw(b,p2)
implicit none
real,intent(in)::b
real,intent(out)::p2
p2=b**2
return
end subroutine pole_kw
end program ko
program macierz3
implicit none
real::a(2,2),b(5,5),z
integer::e,d
do d=1,2
do e=1,2
write(*,*)'Podaj wartosc elementu A',d,e
read(*,*)z
a(d,e)=z
end do
end do
do d=1,2
write(*,*)a(d,:)
end do
write(*,*)'------------------------------------------------------'
a=a+3
do d=1,2
write(*,*)a(d,:)
end do
write(*,*)'------------------------------------------------------'
a=sqrt(a)
do d=1,2
write(*,*)a(d,:)
end do
write(*,*)'------------------------------------------------------'
b=0
b(1:2,1:2)=a
b(4:5,1:2)=a
b(3:4,4:5)=a
do d=1,5
write(*,*)b(d,:)
end do
stop
end program macierz3
program ciag3
implicit none
integer::a,b,c
character(len=1)::d
1 write(*,*)'Podaj pierwsza liczbe'
read(*,*)a
write(*,*)'Podaj druga liczbe'
read(*,*)b
write(*,*)'Wcisnij + jesli chcesz dodac liczby'
write(*,*)'Wcisnij - jesli chcesz odjac liczby'
write(*,*)'Wcisnij * jesli chcesz pomnozycliczby'
write(*,*)'Wcisnij : jesli chcesz podzielic liczby'
read(*,*)d
select case (d)
case('+')
c=a+b
write(*,*)'Wynik dodawania wynosi',c
case('-')
c=a-b
write(*,*)'Wynik odejmowania wynosi',c
case('*')
c=a*b
write(*,*)'Wynik mnozenia wynosi',c
case(':')
c=a/b
write(*,*)'Wynik dzielenia wynosi',c
end select
go to 1
stop
end program ciag3
program macierz4
implicit none
real::a(4,2),b(2,2),c(4,2),z
integer::e,d
do d=1,4
do e=1,2
write(*,*)'Podaj wartosc elementu A',d,e
read(*,*)z
a(d,e)=z
end do
end do
do d=1,4
do e=1,2
write(*,*)'Podaj wartosc elementu B',d,e
read(*,*)z
b(d,e)=z
end do
end do
do d=1,4
do e=1,2
c(d,e)=a(d,e)*b(d,e)+a(d,e+1)*b(d+1,e+1)
end do
end do
do d=1,4
write(*,*)a(d,:)
end do
write(*,*)'------------------------------------------------------'
do d=1,2
write(*,*)b(d,:)
end do
write(*,*)'------------------------------------------------------'
do d=1,4
write(*,*)c(d,:)
end do
write(*,*)'------------------------------------------------------'
stop
end program macierz4
program macierz5
implicit none
real::a,b,c
write(*,*)'Podaj przyprostokatna a:'
read(*,*)a
write(*,*)'Podaj przyprostokatna b:'
read(*,*)b
call przeciw(a,b,c)
write(*,*)'Przeciwprotokatna wynosi:',c
stop
contains
subroutine przeciw(x,y,z)
real,intent(in)::x,y
real,intent(out)::z
z=sqrt(x*x+y*y)
return
end subroutine przeciw
end program macierz5
program macierz6
implicit none
real::b(2,4),ea,h,k(4,4),g
integer::i,j
do i=1,2
do j=1,4
write(*,*)'Podaj element tablicy B:',i,j
read(*,*)g
b(i,j)=g
end do
end do
write(*,*)'Podaj EA:'
read(*,*)ea
write(*,*)'Podaj h:'
read(*,*)h
call oblicz(b,ea,h,k)
write(*,*)'-----------------------------------------------'
write(*,*)'Macierz K ma postac:'
write(*,*)k(1,:)
write(*,*)k(2,:)
write(*,*)k(3,:)
write(*,*)k(4,:)
stop
contains
subroutine oblicz(b,ea,h,k)
real,intent(in)::b(2,4),ea,h
real,intent(out)::k(4,4)
real::d(2,2)
d(1,1)=ea/h
d(1,2)=(-ea)/h
d(2,1)=(-ea)/h
d(2,2)=ea/h
k=matmul(matmul(transpose(b),d),b)
return
end subroutine oblicz
end program macierz6
program macierz
implicit none
integer::a(3,2),b(2,3),c(3),d,e,z
do d=1,3
do e=1,2
write(*,*)'Podaj wartosc elementu A',d,e
read(*,*)z
a(d,e)=z
end do
end do
write(*,*)a
stop
end program macierz
program dodawanie
implicit none
real::a,b,c
write(*,*)'podaj a'
read(*,*) a
write(*,*)'podaj b'
read(*,*) b
c=a+b
write(*,*) c
stop
end program dodawanie
implicit none
real::pierw,delta,a,b,c,x1,x2
write(*,*)'podaj a'
read(*,*) a
write(*,*)'podaj b'
read(*,*) b
write(*,*)'podaj c'
read(*,*) c
delta=b**2.-4.*a*c
if delta<0 then write(*,*)'brak rozwiazania' else
if delta delta>=0 then
pierw=sqrt(delta)
x1=(-b-pierw)/(2.*a)
x2=(-b+pierw)/(2.*a)
write(*,*)'x1='
write(*,*) x1
write(*,*)'x2='
write(*,*) x2
write(*,*)'delta wynosi: '
write(*,*) delta
write(*,*)'pierwiastek z delta wynosi: '
write(*,*) pierw
stop
end program zad4
program zad51
implicit none
real::pierw,delta,a,b,c,x1,x2
write(*,*)'podaj a'
read(*,*)a
write(*,*)'podaj b'
read(*,*)b
write(*,*)'podaj c'
read(*,*)c
delta=b**2.-4.*a*c
write(*,*)'delta wynosi:'
write(*,*)delta
if (delta<0.) then
write(*,*)'brak rozwiazania'
else
pierw=sqrt(delta)
x1=(-b-pierw)/(2.*a)
x2=(-b+pierw)/(2.*a)
write(*,*)'x1='
write(*,*) x1
write(*,*)'x2='
write(*,*) x2
end if
stop
end program zad51
program jakis
implicit none
real::a
write(*,*)'podaj a'
read(*,*)a
a=a+1.
write(*,*)a
a=a+1.
write(*,*)a
a=a+1.
write(*,*)a
stop
end program jakis
Program kk
implicit none
character(7)::a
real::r,b,pole1,pole2
write(*,*)'Wpisz kolo jesli liczysz pole kola'
write(*,*)'Wpisz kwadrat jesli liczysz pole kwadratu'
read(*,*)a
select case (a)
case('kolo')
write(*,*)'Podaj promien kola'
read(*,*)r
call pole_kola(r,pole1)
write(*,*)'Pole kola wynosi:',pole1
case('kwadrat')
write(*,*)'Podaj bok kwadratu'
read(*,*)b
call pole_kw(b,pole2)
write(*,*)'Pole kwadratu wynosi:',pole2
end select
stop
contains
subroutine pole_kola(r,pole1)
implicit none
real,intent(in)::r
real,intent(out)::pole1
pole1=3.14*r*r
return
end subroutine pole_kola
subroutine pole_kw(b,pole2)
implicit none
real,intent(in)::b
real,intent(out)::pole2
pole2=b*b
return
end subroutine pole_kw
end program kk