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.
Tutorialspoint

Program_Array with Where

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
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.