Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
program hello
!declare
type my_type
character(len=10) idno
integer score
character(len=1) grade
end type my_type
type (my_type), dimension (:), allocatable :: stu,tmp
character(len=10) tidno
integer tscore,n,ios,minarrsize
10 format (a10,1x,i3)
20 format (a10,1x,i3,1x,a1)
minarrsize = 5
allocate(tmp(minarrsize))
! read data to dynamic array - tmp
n = 0
do
read(*,10,iostat=ios) tidno,tscore
if (ios > 0) then
write(*,*) 'read data error !'
stop
else if (ios < 0) then
exit
else
n = n + 1
if (n .gt. size(tmp)) then
call resize()
end if
tmp(n)%idno = tidno
tmp(n)%score = tscore
end if
end do
! assign temp to score with exatcly length & value
allocate(stu(n))
stu(1:n) = tmp(1:n)
deallocate(tmp)
! process array with where
where (stu%score .ge. 90)
stu%grade = 'A'
elsewhere (stu%score .ge. 80)
stu%grade = 'B'
elsewhere (stu%score .ge. 70)
stu%grade = 'C'
elsewhere (stu%score .ge. 60)
stu%grade = 'D'
elsewhere
stu%grade = 'F'
endwhere
! print out the result
write(*, *) '----------result data----------'
do i = 1, n
write(*, 20) stu(i)%idno,stu(i)%score,stu(i)%grade
end do
! end program
deallocate(stu)
! subprogram
contains
subroutine resize()
!double the size for array temp
implicit none
type (my_type), dimension (:), allocatable :: tt
integer :: s
s = size(tmp)
allocate(tt(s))
tt = tmp
if (allocated(tmp)) deallocate(tmp)
allocate(tmp(s * 2))
tmp(1:s) = tt
deallocate(tt)
end subroutine resize
end program Hello
program massive
integer i, c, z, m1, m2
integer a(7)
print*, 'введи массив'
read*, a
print*, 'массив:', a
!m1-максимальный элемент слева
m1=a(1)
do i=1,3
if (a(i).gt.m1) then
m1=a(i)
z=i
end if
end do
!m2-максимальный элемент справа
m2=a(5)
do i=5,7
if (a(i).gt.m2) then
m2=a(i)
c=i
end if
end do
a(c)=m1
a(z)=m2
print*, 'измененный массив:', a
end program massive
!---------------------------------------------------------------------------------
--------------------------------------------------------------------------------------
!Runge-Kutta method of order four to solve an IVP
--------------------------------------------------------------------------------------
PROGRAM RK4
integer iter
iter=0
write(*,*)'Enter initial value x0,y0 and expected function
value at x1:'
read(*,*) x0,y0,x1
write(*,*)'Enter the number of subintervals:'
read(*,*) n
h=(x1-x0)/real(n)
write(*,30)
30 format(8x,'x',5x,'f(x)')
write(*,40)x0,y0
40 format(1x,F10.4,F10.4)
50 s1=f(x0,y0)
s2=f(x0+h/2.,y0+s1*h/2.)
s3=f(x0+h/2.,y0+s2*h/2.)
s4=f(x0+h,y0+s3*h)
y1=y0+(s1+2.*s2+2.*s3+s4)*h/6.0
x1=x0+h
write(*,40)x1,y1
iter = iter+1
IF(iter.LT.n) THEN
x0=x1
y0=y1
GOTO 50
ENDIF
write(*,60) x1,y1
60 format(1x,'The value at','F10.4,','is:',F10.4)
STOP
END
!==============Given Function===============
function f(x,y)
f=x-y**2
return
END
