program reform parameter isize=4000 parameter ns=200 dimension iy(isize),nc(isize) DIMENSION IBUFF(10) character*8 adent character*6 dent ic1=3 ic2=6 is=5752 ie=8994 read(ic1,*)ixx read(ic1,*)(iy(i),i=1,3243) do 20 n=1,isize 20 nc(n)=1 dent(1:6)=' yamal' call winfrn(dent,is,ie,iy,nc,isize,ic2) 800 stop end subroutine rintrl(adent,isy,iey,ix,isize,ic1,ifin) dimension ibuff(10),ix(isize) CHARACTER*80 LINE character*8 adent c read(ic1,51)skip 51 format(a2) i=1 do 1 k=1,1000 C read(ic1,50,end=100)adent,iys,(ibuff(n),n=1,10) C 50 format(a8,I4,10i6) c do 40 n=1,10 c if(abuff(n) .ne. ' ')then c ibuff(n)=abuff(n) c endif c 40 continue READ(IC1,'(A80)',END=1000)LINE READ(LINE,'(A8,I4,10I6)',END=1000)ADENT,IYS,IBUFF if(i.eq.1)isy=iys ish=mod(iys,10) ibe=10-ish do 2 il=1,ibe if(ibuff(il).eq.999 .or. ibuff(il) .lt. 0)then iey=isy+i-2 go to 100 else ix(i)=ibuff(il) i=i+1 endif 2 continue 1 continue 100 return 1000 ifin=1 return end SUBROUTINE WINFRN(DENT,ISYEAR,IEYEAR,IY,NC,ISIZE,IC) DIMENSION IY(ISIZE),NC(ISIZE) CHARACTER*6 DENT N=IEYEAR-ISYEAR+1 NN=N WRITE(IC,12)DENT,ISYEAR,IEYEAR 12 FORMAT(a6,2I4) IYS=MOD(ISYEAR,10) IF(IYS.EQ.0)GO TO 23 IIY=N+IYS IIX=IIY NNN=N DO 11 III=1,NNN IY(IIX)=IY(N) NC(IIX)=NC(N) IIX=IIX-1 N=N-1 11 CONTINUE DO 13 I=1,IYS IY(I)=9990 NC(I)=0 13 CONTINUE GO TO 15 23 CONTINUE IIY=N 15 MIE=10-(MOD(IEYEAR,10)+1) IF(MIE.EQ.0)GO TO 20 IAY=IIY+1 IBY=(IAY+MIE)-1 DO 17 NN=IAY,IBY IY(NN)=9990 NC(NN)=0 17 CONTINUE GO TO 18 20 IAY=IIY+1 IBY=IAY 18 WRITE(IC,19)DENT,ISYEAR,(IY(I),NC(I),I=1,10) 19 FORMAT(a6,I4,10(I4,I3)) IX=(IBY/10)-1 IN=11 INN=IN+9 IDEC=((ISYEAR+10)/10)*10 DO 9 IS=1,IX WRITE(IC,7)DENT,IDEC,(IY(I),NC(I),I=IN,INN) 7 FORMAT(a6,I4,10(I4,I3)) IN=IN+10 INN=IN+9 IDEC=IDEC+10 9 CONTINUE DO 30 I=1,NN NC(I)=NC(I+IYS) 30 IY(I)=IY(I+IYS) RETURN END