PROGRAM REFORM PARAMETER ISIZE=10000 DIMENSION Y(ISIZE),IY(ISIZE),IX(ISIZE) CHARACTER*6 DENT character*9 fmt character*70 inf1,of1 nts=1000 ic=12 write(*,101) 101 format(/,1x,'THIS PROGRAM REFORMATS COMPACT TO RINFRN DATA') write(*,100) 100 format(/,1x,'TYPE IN FILENAME OF INPUT DATA - CASE CORRECT!') READ(*,103)INF1 103 FORMAT(A70) OPEN(11,FILE=INF1,STATUS='OLD') WRITE(*,102) 102 FORMAT(/,1X,'TYPE IN FILENAME FOR OUTPUT DATA') READ(*,103)OF1 OPEN(12,FILE=OF1,STATUS='NEW') DO 25 K=1,NTS read(11,21)nyr,iy1,dent,fmt 21 format(4x,i4,5x,i5,3x,a6,44x,a9) iy1=iy1+7000 write(*,78)nyr,iy1,dent,fmt 78 format(1X,2i5,1x,a6,1x,a9) read(11,fmt)(y(i),i=1,nyr) iy2=iy1+nyr-1 do 22 i=1,nyr iy(i)=y(i)+0.5 ix(i)=1 22 continue call winfrn(dent,iy1,iy2,iy,ix,isize,ic) 25 CONTINUE STOP END SUBROUTINE RINFRN(DENT,ISYEAR,NUM,X,NC,ISIZE,IC) DIMENSION X(ISIZE),NC(ISIZE) CHARACTER*8 DENT CHARACTER*4 TYPE,FORM READ(IC,100)DENT(1:6),ISYEAR,IEYEAR,TYPE,FORM 100 FORMAT(A6,2I4,2X,2A4,F4.1,F6.1,A4,I1) DENT(7:8)=' ' N=IEYEAR-ISYEAR+1 K=MOD(ISYEAR,10) NR=N+K READ(IC,101)(X(I),NC(I),I=1,NR) 101 FORMAT((10X,10(F4.0,I3))) DO 1 I=1,N NC(I)=NC(I+K) 1 X(I)=X(I+K) NUM=IEYEAR-ISYEAR+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