инфа / проги инфа вар 1,2(родионова) / файлы

Program main
Character name*30,c*2,FIO*30,num*6,date*8,fmt1*100,z*2,name1*30,fmt2*30,char1*30,ysl1*6,name2*30
Integer regim,vewi,ves,k,vivod,srves,obwves,l
Logical p, exist,exist1
fmt1='(3x,A30,3x,A6,3x,A8,3x,I2,3x,I3)'
fmt2='(1x,I5)'
char1=' sredniy ves:'
c='y'
Do while(c=='y'.or.c=='Y')
Write(*,*)'vozmognie regimi raboti'
Write(*,16)
16 Format(1x,'1-sozdanie ishodnogo faila'/1x,'2-prosmotr faila'/1x,'3-sozdaie resultiruewego 1 faila'/1x,'4-sozdanie rezultiruewego 2 faila'/1x,'5-redaktirovanie zapisi v ishodnom faile'/1x,'6-dobavlenie zapisi v ishodnii fail'/1x,'7-konec programmi'/1x,'8-ispolzovat yge sywestvyuwii ishodnik'/1x,'9-ydalenie zapisi')
Read(*,*)regim
Select Case(regim)
Case(1)
p=.true.
Do while(p)
Write(*,*)'vvedite imya sozdavaemogo faila'
Read(*,*)name
p=exist(name)
End Do
Open(1,file=name,access='direct',status='new',recl=150)
k=0
z='y'
Do While(z=='y'.or.z=='Y')
k=k+1
write(*,106) k
106 format (3x,'vvodim',I3,' zapis:')
write(*,*)' vvedite FIO (<=30 simvolov)'
read(*,'(A30)')FIO
write(*,*)' vvedite nomer reisa(= xxxxxx) '
read(*,'(A6)')num
write (*,*)' vvedite daty vileta po formaty xx.xx.xx (god.mes9c.den)'
read(*,'(A8)')date
write(*,*)' vvedite koli4estvo veshei (<=xx)'
read(*,'(I2)')vewi
write(*,*)' vvedite obshii ves veshei(<=xxx)'
read(*,'(I3)')ves
Write (1,rec=k) fio,num,date,vewi,ves
write(*,*) ' Eshe zapis? (y/n)'
read(*,'(A2)')z
End DO
close(1,status='keep')
write(*,107) name,k
107 format (2x,'Fail ',A30,' sformirovan. V nem',I3,' zna4ashih zapisey')
Case(2)
Write(*,*)'kakoi fail vivodim: 1-ishodniy;2-resultiryuwii 1;3-rezultiryuwii 2'
Read(*,*)vivod
Select Case (vivod)
Case(1)
IF(Exist1(name)) then
open (1,file=name,access='direct',status='old',recl=150)
write(*,206)
206 format (3x,'fio',30x,'nomer',4x,'data',6x,'vewi',1x,' obwii ves'/)
k=0
Do While (.not.eof(1))
k=k+1
read (1,rec=k) fio,num,date,vewi,ves
write(*,fmt1)fio,num,date,vewi,ves
End Do
close(1,status='keep')
Else
Write(*,*)'Error'
End IF
Case(2)
IF(Exist1(name1)) then
Open (2,file=name1,access='sequential',form='formatted',status='old')
write(*,207)
207 format (3x,'fio',30x,'nomer',4x,'data',5x,'vewi',3x,' obhii ves'/)
Do While(.not.eof(2))
Read (2,fmt1) fio,num,date,vewi,ves
Write(*,fmt1)fio,num,date,vewi,ves
End Do
Close(2,status='keep')
Pause
Else
Write(*,*)'Error'
End IF
Case(3)
IF(Exist1(name2)) then
open (3,file=name2,access='direct',status='old',recl=150)
write(*,208)
208 format (3x,'fio',30x,'nomer',4x,'data',6x,'vewi',1x,' obwii ves'/)
k=0
Do While (.not.eof(3))
k=k+1
read (3,rec=k) fio,num,date,vewi,ves
write(*,fmt1)fio,num,date,vewi,ves
End Do
close(3,status='keep')
End IF
End Select
Case(3)
p=.true.
Do while(p)
Write(*,*)'vvedite imya sozdavaimogo resultiryewego 1 faila'
Read(*,*)name1
p=exist(name1)
End Do
Open(1,file=name,access='direct',status='old',recl=150)
Open(2,file=name1,access='sequential',form='formatted',status='new')
k=0
obwves=0
l=0
Do while(.not.eof(1))
k=k+1
Read(1,rec=k) fio,num,date,vewi,ves
IF((vewi==1).and.(ves<30)) then
Write(2,fmt1) fio,num,date,vewi,ves
obwves=obwves+ves
l=l+1
End IF
End Do
IF(l/=0) then
Write(2,'(A30)')char1
srves=obwves/l
Write(2,fmt2)srves
End IF
Close(1)
Close(2)
Pause
Case(4)
p=.true.
Do while(p)
Write(*,*)'vvedite imya sozdavaimogo resultiryewego 2 faila'
Read(*,*)name2
p=exist(name2)
End Do
Write(*,*)'vvedite nomer nygnogo reisa'
Read(*,*)ysl1
Open(1,file=name,access='direct',status='old',recl=150)
Open(3,file=name2,access='direct',status='new',recl=150)
k=0
l=0
Do while(.not.eof(1))
k=k+1
Read(1,rec=k) fio,num,date,vewi,ves
IF(num==ysl1) then
l=l+1
Write(3,rec=l)fio,num,date,vewi,ves
End IF
End DO
Close(1)
Close(3)
Call Upor(name2)
Write(*,*)'fail sozdan'
Pause
Case(5)
p=.false.
Do while(.not.p)
p=exist1(name)
IF(.not.p) then
Write(*,*)'vvedite name faila'
Read(*,*)name
End IF
End Do
Open(1,file=name,access='direct',status='old',recl=150)
Write(*,*)'vvedite nomer nygnoi zapisi'
Read(*,*)k
Read(1,rec=k)fio,num,date,vewi,ves
Write(*,*)'nygnaya vam zapis:'
Write(*,506)
506 format (3x,'fio',30x,'nomer',4x,'data',6x,'vewi',1x,' obwii ves'/)
Write(*,fmt1)fio,num,date,vewi,ves
Pause
write(*,*)' vvedite FIO (<=30 simvolov)'
read(*,'(A30)')FIO
write(*,*)' vvedite nomer reisa(= xxxxxx) '
read(*,'(A6)')num
write (*,*)' vvedite daty vileta po formaty xx.xx.xx (god.mes9c.den)'
read(*,'(A8)')date
write(*,*)' vvedite koli4estvo veshei (<=xx)'
read(*,'(I2)')vewi
write(*,*)' vvedite obshii ves veshei(<=xxx)'
read(*,'(I3)')ves
Write (1,rec=k) fio,num,date,vewi,ves
Close(1)
Case(6)
p=.false.
Do while(.not.p)
p=exist1(name)
IF(.not.p) then
Write(*,*)'vvedite name faila'
Read(*,*)name
End IF
End Do
Open(1,file=name,access='direct',status='old',recl=150)
k=0
Do while(.not.eof(1))
k=k+1
Read(1,rec=k)
End Do
write(*,*)' vvedite FIO (<=30 simvolov)'
read(*,'(A30)')FIO
write(*,*)' vvedite nomer reisa(= xxxxxx) '
read(*,'(A6)')num
write (*,*)' vvedite daty vileta po formaty xx.xx.xx (god.mes9c.den)'
read(*,'(A8)')date
write(*,*)' vvedite koli4estvo veshei (<=xx)'
read(*,'(I2)')vewi
write(*,*)' vvedite obshii ves veshei(<=xxx)'
read(*,'(I3)')ves
Write (1,rec=k+1) fio,num,date,vewi,ves
Close(1)
Case(7)
c='n'
Case(8)
Write(*,*)'vvedite imya faila'
Read(*,*)name
Case(9)
p=.false.
Do while(.not.p)
p=exist1(name)
IF(.not.p) then
Write(*,*)'vvedite name faila'
Read(*,*)name
End IF
End Do
Open(1,file=name,access='direct',status='old',recl=150)
k=0
Do while(.not.eof(1))
k=k+1
Read(1,rec=k)
End Do
Write(*,*)'vvedite nomer ydalyaemoi zapisi'
Read(*,*)l
Do i=l,k-1
Read(1,rec=i+1)fio,num,date,vewi,ves
Write(1,rec=i)fio,num,date,vewi,ves
End Do
Endfile(1)
Close(1)

Case Default
Write(*,*)'Error'
End Select
End Do
Write(*,*)'Konec raboti'
End

Logical Function Exist(name)
Character name*30
Logical flag
Integer error
INQUIRE (file=name, exist=flag)
IF (.not.flag) then
Exist=.false.
Else
Write(*,*)'takoi fail yge sywestyet 4to bydem delat?'
Write(*,*)'1-ydalim sywestvyuwii;2-vvedem drygoe imya'
Read(*,*)Error
Select Case(error)
Case(1)
Open(9,file=name)
Close(9,status='delete')
Case(2)
Exist=.true.
Case Default
Write(*,*)'Error'
Exist=.true.
End Select
End IF
End

Logical Function Exist1(name)
Character name*30
Logical flag
flag=.false.
Do while(.not.flag)
INQUIRE (file=name, exist=flag)
IF (flag) then
Exist1=.true.
Else
Write(*,*)'takoi faila ne sywestyet vvedite drygoe imya'
Read(*,*)name
End IF
End Do
End

Subroutine UPOR(name)
Character name*30,fio1*30,num1*6,date1*8,fio2*30,num2*6,date2*8
Integer j,i,ves1,ves2,vewi1,vewi2
Open(4,file=name,access='direct',status='old',recl=150)
k=0
Do While(.not.eof(4))
k=k+1
read(4,rec=k)
End Do
Pause
Do i=k-1,1,-1
Do j=1,i
Read (4,rec=j)fio1,num1,date1,vewi1,ves1
Read (4,rec=j+1)fio2,num2,date2,vewi2,ves2
IF(fio1>fio2) then
Write(4,rec=j)fio2,num2,date2,vewi2,ves2
Write(4,rec=j+1)fio1,num1,date1,vewi1,ves1
End IF
End Do
End Do
Close(4)
End