Derived data types : database를 읽어 정렬하기

Derived Data Types

database를 읽어 선택한 필드로 정렬하기

Passing user-defined function as arguments to subroutine

MODULE types

IMPLICIT NONE

TYPE :: personal_info

CHARACTER(len=12) :: first
CHARACTER :: mi
CHARACTER(len=12) :: last
CHARACTER(len=26) :: street
CHARACTER(len=12) :: city
CHARACTER(len=2) :: state
INTEGER :: zip

END TYPE personal_info

END MODULE types

위 소스를 types.f95로 저장

PROGRAM customer_batabase

USE types

IMPLICIT NONE

INTEGER, PARAMETER :: MAX_SIZE = 100

LOGICAL, EXTERNAL :: lt_last ! function name
LOGICAL, EXTERNAL :: lt_city ! function name
LOGICAL, EXTERNAL :: lt_zip ! function name

TYPE(personal_info), DIMENSION(MAX_SIZE) :: customers

INTEGER :: choice
LOGICAL :: exceed = .FALSE.

CHARACTER(len=40) :: filename
INTEGER :: i
INTEGER :: nvals = 0
INTEGER :: status
TYPE(personal_info) :: temp

WRITE (*,*) 'Enter the file name with custormer database:'
READ (*,'(A40)') filename

OPEN (UNIT = 9, FILE = filename, STATUS = 'OLD', IOSTAT = status)

IF (status == 0) THEN
! open successful
DO
READ (9, 1010, IOSTAT = status) temp
1010 FORMAT (A12, 1X, A1, 1X, A12, 1X, A26, 1X, A12, 1X, A2, 1X, I5)
IF (status /= 0) EXIT ! exit on end of data
nvals = nvals + 1
IF (nvals <= MAX_SIZE) THEN
customers(nvals) = temp
ELSE
exceed = .TRUE.
END IF
END DO

IF (exceed) THEN
WRITE (*,1020) nvals, MAX_SIZE
1020 FORMAT (' Maximum array size exceeded: ', I6, ' > ', I6)
ELSE
WRITE (*, 1030)
1030 FORMAT (1X, 'Enter way to sort database:', /, &
1X, ' 1 -- By last name ' ,/, &
1X, ' 2 -- By city ' ,/, &
1X, ' 3 -- By zip code ')
READ (*,*) choice

SELECT CASE (choice)
CASE (1)
CALL sort_database(customers, nvals, lt_last) ! Passing user-defined function as arguments to subroutine
CASE (2)
CALL sort_database(customers, nvals, lt_city) ! Passing user-defined function as arguments to subroutine
CASE (3)
CALL sort_database(customers, nvals, lt_zip) ! Passing user-defined function as arguments to subroutine
CASE DEFAULT
WRITE (*,*) 'Invalid choice entered!'
END SELECT

WRITE (*,'(A)') ' The sorted database values are: '
WRITE (*, 1040) (customers(i), i = 1, nvals)
1040 FORMAT (1X, A12, 1X, A1, 1X, A12, 1X, A26, 1X, A12, 1X, A2, 1X, I5)
END IF

ELSE
! open error occurred
WRITE (*,'(A,I6)') ' File open error: IOSTAT = ', status

END IF

END PROGRAM customer_batabase

SUBROUTINE sort_database(array, n, lt_fun)

USE types

IMPLICIT NONE

INTEGER, INTENT(IN) :: n
TYPE(personal_info), DIMENSION(n), INTENT(INOUT) :: array

LOGICAL, EXTERNAL :: lt_fun

INTEGER :: i
INTEGER :: iptr
INTEGER :: j
TYPE(personal_info) :: temp

DO i = 1, n - 1
iptr = i
DO j = i + 1, n
IF (lt_fun(array(J), array(iptr))) THEN
iptr = j
END IF
END DO

IF ( i /= iptr) THEN
temp = array(i)
array(i) = array(iptr)
array(iptr) = temp
END IF
END DO

END SUBROUTINE sort_database

LOGICAL FUNCTION lt_last(a, b)

USE types
IMPLICIT NONE

TYPE (personal_info), INTENT(IN) :: a, b

lt_last = LLT(a%last, b%last)

END FUNCTION lt_last

LOGICAL FUNCTION lt_city(a, b)

USE types
IMPLICIT NONE

TYPE (personal_info), INTENT(IN) :: a, b

lt_city = LLT(a%city, b%city)

END FUNCTION lt_city

LOGICAL FUNCTION lt_zip(a, b)

USE types
IMPLICIT NONE

TYPE (personal_info), INTENT(IN) :: a, b

lt_zip = a%zip < b%zip

END FUNCTION lt_zip

위 소스를 personal_info.f95

text database

John Q Public 123 Sesame Street Anywhere NY 10035
James R Johnson Rt. 5 Box 207C West Monroe LA 71291
Joseph P Ziskend P. O. Box 433 APO AP 96555
Andrew D Jackson Jackson Square New Orleans LA 70003
Jane X Doe 12 Lakeside Drive Glenview IL 60025
Colin A Jeffries 11 Main Street Chicago IL 60003

위 자료를 customer_database.txt로 저장

컴파일 및 프로그램 테스트