Томский государственный университет систем управления и радиоэлектроники
Опубликован: 01.11.2012 | Доступ: свободный | Студентов: 637 / 74 | Длительность: 06:01:00
Лекция 5:

Файлы

< Лекция 4 || Лекция 5: 123 || Лекция 6 >

Оператор Flush

Сброс логических буферов при буферизованном выводе

program prog
integer, parameter :: N = 100
real A(N)
  open(1, buffered = 'yes', file = 'dat')
  write(1, *) A
  flush(1) 

  call C_subroutine('dat') ! читает данные из файла dat
! ----- некоторый код
end

При буферизации, логически записанные данные могут физически не успеть попасть на диск, что вызовет ошибку чтения данных.

Процедуры модуля ifport

ACCESS Определение доступа к файлу
CHANGEDIRQQ Установка директории текущей
CHANGEDRIVEQQ Установка диска текущим
CHDIR Смена рабочей директории
CHMOD Смена атрибутов файла
DELDIRQQ Удаление директории
DELFILESQQ Удаление файлов
FINDFILEQQ Поиск файлов
FULLPATHQQ Полное имя файла или директории
GETDRIVEDIRQQ Путь текущей рабочей директории
GETDRIVESIZEQQ Размер текущего диска и доступного пространства
GETDRIVESQQ Имена имеющихся дисков
GETFILEINFOQQ Информация о файле
PACKTIMEQQ Упаковывает время для использования в SETFILETIMEQQ
RENAMEFILEQQ Переименование файла
SETFILEACCESSQQ Способ доступа к файлу
SETFILETIMEQQ Установка даты изменения файла
SPLITPATHQQ Выделяет в полном имени 4 компоненты файла (диск, папки, имя, расширение)
UNPACKTIMEQQ Распаковка упакованного времени

* З а д а н и е *

Промежуточное сохранение вычислений. В программе save_results организовать промежуточное автосохранение массива A через каждые auto итераций в файл numerical.save.

Предусмотреть:

  1. возможность продолжения вычислений при повторном запуске программы;
  2. обработку ошибок;

*Задание*

program SAVE_DATA
use ifport
implicit none
integer, parameter :: M = 150 
real(16) A(M,M,M), B(M,M,M), C(M,M,M) 
integer, parameter :: N = 1000  ! кол-во итераций
integer i,j,k,it
do it = 1,N
  write(*,*) "Current iteration = ",it
  call random_number(A)
  call random_number(B)
  call random_number(C)
  do i = 1,M
  do j = 1,M
  do k = 1,M
    A(i,j,k) = exp(B(k,j,i))*cos(C(j,k,i)**A(i,k,j))
  end do
  end do
  end do
end do
END

* Вариант программы *

program save_data
use ifport
implicit none

integer, parameter :: M=150 
real(16) A(M,M,M), B(M,M,M), C(M,M,M) 
integer, parameter :: N = 1000  ! кол-во итераций

character(20) ::    name = 'C:\numerical.save', & ! файл автосохранения
                 tmpname = 'C:\numerical.tmp'     ! файл временной копии

integer, parameter :: auto = 10 ! интервал автосохранения
integer i,j,k,it, itstart, ires
logical ex, ext

inquire(file=name,    exist = ex)  
inquire(file=tmpname, exist = ext) 

if (.NOT. ex) then ! если нет файла автосохранения
  if (.NOT. ext) then ! если нет временной копии
    write(*,*) "No data saved. Starting at iteration = 1"  ! 1) тогда новый  расчет
    itstart=1
  else
    open(1,file=tmpname, status='OLD', form='binary') ! 2) иначе данные могут быть во временой копии
    read(1, ERR=100, END=101) itstart, A 
    write(*,*) "Data was saved at iteration = ", itstart
    close(1)
  end if
else
  write(*,*) "Reading saved data from file....." ! 3) данные могут быть в файле автосохранения
  open(1,file=name, status='OLD', form='binary')
  read(1, ERR=100, END=101) itstart, A
  close(1)
  if (ext) then ! 4) если есть файл и временная копия
    write(*,*) "Finding more than one copy. Deleted..."
    ires=DelFilesQQ(tmpname) 
  end if
end if

* Вариант программы *

do it=itstart,N
  write(*,*) "Current iteration = ",it

  if (mod(it,auto)==0) then   ! автосохранение промежуточных вычислений
    open(2, file=tmpname, form='binary') ! сначала сохраняем во временный файл
    write(2,ERR=102) it, A
    close(2)
    ires=DelFilesQQ(name) ! удаляем предыдущий файл автосохранения
    ires=RenameFileQQ (tmpname, name) ! файлом автосохранения становится временная копия
    write(*,*) "Data succesfully saved at iteration = ", it
  end if

  call random_number(A)
  call random_number(B)
  call random_number(C)

  do i=1,M
  do j=1,M
  do k=1,M
    A(i,j,k)=exp(B(k,j,i))*cos(C(j,k,i)**A(i,k,j))
  end do
  end do
  end do

end do
stop

! ----- обработка ошибок ------
100 stop "Error while reading data file !"
101 stop "End of data file encountered !"
102 stop "Error while writing data file !"

END


< Лекция 4 || Лекция 5: 123 || Лекция 6 >