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
Advertisements
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.
AcceptLearn more