SHARE
TWEET

Untitled

yloven Feb 17th, 2019 106 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.     program CourceWork_Mozer
  2.     implicit none
  3.     type student_data
  4.         character(len = 15) :: surname, name, patronymic
  5.         integer :: day, month, year
  6.         character(len = 11) :: telephone_number
  7.         character(len = 18) :: flowers
  8.     end type student_data
  9.     !--
  10.     logical :: search_result
  11.     type(student_data) :: current_student
  12.     !--
  13.     write(*, *) '= Enter surname...'
  14.     read(*, '(A15)') current_student%surname
  15.     call student_searh(current_student, search_result)
  16.  
  17.     if (search_result) then
  18.         call student_output(current_student)
  19.     end if
  20.  
  21.     write(*, *) '= End program...'
  22.     pause
  23.  
  24.     contains
  25.     subroutine student_searh(student, search_result)
  26.     implicit none
  27.     type(student_data), intent(inout) :: student
  28.     logical, intent(out) :: search_result
  29.     type(student_data) :: student_database
  30.     !--
  31.     if (student%surname == '') then
  32.         write(*, *) '= Incorrect input!'
  33.         search_result = .false.
  34.         return
  35.     end if
  36.  
  37.     write(*, *) '= Search in database...'
  38.     open(unit = 1, file = 'GR_M1O_101B_18.TXT', status = 'old')
  39.  
  40.     do
  41.         read(1, 201, end = 199) student_database%surname, student_database%name, student_database%patronymic, student_database%day, student_database%month, student_database%year, student_database%telephone_number, student_database%flowers
  42.  
  43.         if (student%surname == student_database%surname) then
  44.             write(*, *) '= Student was found.'
  45.             student = student_database
  46.             search_result = .true.
  47.             exit
  48.         end if
  49.     end do
  50.  
  51.     go to 200
  52. 199 write(*, *) "= Student wasn't found."
  53.     search_result = .false.
  54. 200 close(1)
  55. 201 format(A15, A15, A15, I2, I2, I2, A11, A18)
  56.     end subroutine student_searh
  57.  
  58.     subroutine student_output(student)
  59.     implicit none
  60.     character(len = 87) :: output(2)
  61.     character(len = 23) :: format_integer
  62.     character(len = 9), dimension(12) :: months = (/'January', 'February', 'March', 'April', 'May', 'June', 'July', 'August', 'September', 'October', 'November', 'December'/)
  63.     type(student_data), intent(in) :: student
  64.     !-- Full name
  65.     output(1) = trim(student%surname)//' '//trim(student%name)//' '//trim(student%patronymic)
  66.     !-- Birthday
  67.     if (student%flowers == '') then
  68.         output(1) = trim(output(1))//' (male) was born on '//months(student%month)
  69.     else
  70.         output(1) = trim(output(1))//' (female) was born on '//months(student%month)
  71.     endif
  72.  
  73.     if (student%year < 90) then
  74.         output(2) = ', 200'
  75.         format_integer = '(A, A, A, I2, A, I1, A)'
  76.     else
  77.         output(2) = ', 19'
  78.         format_integer = '(A, A, A, I2, A, I2, A)'
  79.     end if
  80.  
  81.     write(*, format_integer) ' ---> ', trim(output(1)), ' ', student%day, trim(output(2)), student%year, '.'
  82.     !-- Telephone
  83.     if (student%flowers == '') then
  84.         output(1) = '---> Contact him'
  85.     else
  86.         output(1) = '---> Contact her'
  87.     end if
  88.  
  89.     if (student%telephone_number /= '') then
  90.         output(1) = trim(output(1))//' by phone '//student%telephone_number(1:1)//' ('//student%telephone_number(2:4)//') '//student%telephone_number(5:7)//'-'//student%telephone_number(8:9)//'-'//student%telephone_number(10:11)//'.'
  91.     else
  92.         output(1) = trim(output(1))//' personally.'
  93.     endif
  94.  
  95.     write(*, *) trim(output(1))
  96.     !-- Flowers
  97.     if (student%flowers /= '') then
  98.         output(1) = '---> P.S. '//trim(student%flowers)//' are favorite flowers.'
  99.         write(*, *) trim(output(1))
  100.     end if
  101.  
  102.     end subroutine student_output
  103.     end program CourceWork_Mozer
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top