Subroutine del_zap ()

implicit none

integer i, k

real x

!открываем исходный файл

open (30, file='f_dir.txt', access='direct', form='unformatted', recl=4)

!открываем временный файл (неформатный)

open(10, form='unformatted', status='scratch')

i=0!формирование номера записи

do while (.not.eof (30))

i=i+1

read(30, rec=i) x!прочитали запись из исходного файла

if (x>0)then

write(10) x!записали во временный файл

endif

enddo

rewind(10)!вернулись на начало временного файла

close(30, status='delete')! удалили исходный файл

! заново открыли исходный файл

open (30, file='f_dir.txt', access='direct', form='unformatted',recl=4)

i=0

do while (.not.eof (10))

i=i+1

read (10) x! прочитали запись из временного файла

write (30, rec=i)x! записал в основной

enddo

close(10)

close(30)

End subroutine

Пример

Создание информационно-справочной системы

Дан файл, содержащий сведения о товарах: название товара, цена, количество единиц товара. Получить сведения об общей стоимости товара определенного наименования и его количестве.

Выберем для создания неформатный файл прямого доступа.

Написать программу, позволяющую выбрать из предлагаемого меню определенный пункт.

1. Создание файла

2. Просмотр

3. Справка

4. Выход

Создадим текстовый форматный файл menu.txt с текстом меню (либо в блокноте, либо в редакторе CVF).

Menu

1 create

2 view

3 spravka

0 out

Viberi punkt menu

Напишем модуль описания (чтобы не писать описание структуры во всех процедурах).

Module global

implicit none

integer, parameter::n=30!количество записей

Type tovar

Character (20) name

integer kol

real cost

End type tovar

Type (tovar) z!переменная производного типа

integer I!номер записи в файле прямого доступа

character(79) str!переменная симв. типа для вывода строки из файла меню меню на экран

character(1) pm!пункт меню

End module

! Главная программа

Program main

use global! модуль общих описаний

call obr_menu()! вызо в процедуры обработки меню

End

Процедура обработки меню

Subroutine obr_menu()

Use global

open(10, file='menu.txt')

pm='1'

cicl1: do while(pm/='0')

rewind (10)!установка на начало

call system('cls' )!очистка экрана

cicl2: do while(.not. eof(10))

read (10,'(A)') str! чтение из файла строки меню

print*, str!вывод на экран этой строки

enddo cicl2

read*, pm!считывание нажатой клавиши

select case (pm)! обработка выбранного пункта меню

case('1')

call create()

case('2')

call view()

case('3')

call inform()

case('0')

exit

Endselect

read*! задержка текста меню на экране

Enddo cicl1

close(10)

End subroutine obr_menu

! Процедура создания файла прямого доступа

Subroutine create()