PROGRAM CROSSX
      DIMENSION X(2000),YZ(2000),Y(2000)
      DIMENSION ixy(2000),ixz(2000)   
      character*6 fdent(100)
      character*6 adent,dent
      character*8 dent8
      character*11 filename
      nmaxc=2000
      do 21 k=1,1000
      read(2,22,end=99)filename
   22 format(a11)
      if(filename(1:1).eq.'0')go to 56
      dent=filename(1:6)
      go to 55
   56 dent(2:6)=filename(1:5)
      dent(1:1)='U'
   55 open(1,file=filename,status='old',readonly)
      kc=0
      do 23 i=1,3
   23 read(1,24)aa
   24 format(a4)
   25 read(1,*)iz
      if(iz.eq.999)go to 26
      kc=kc+1
      ixy(kc)=iz
      go to 25
   26 iy3=1
      iy4=kc
      nn=kc
      close(1)
      do 31 j=1,nn
   31 ixz(j)=1
      call winfrn(dent,iy3,iy4,ixy,ixz,nmaxc,8,kch)
   21 continue
   99 continue
      STOP  
      END   
      SUBROUTINE RINFRN(DENT,ISYEAR,IEYEAR,ITYPE,ALAT,ALONG,ISP,
     &IAREA,X,NC,ISIZE,IC)  
      DIMENSION X(ISIZE),NC(ISIZE)  
      character*6 dent
      READ(IC,100)DENT,ISYEAR,IEYEAR 
  100 FORMAT(A6,2I4,I1,F4.1,F6.1,A4,I1) 
      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)   
      RETURN
      END   
      SUBROUTINE WINFRN(DENT,ISYEAR,IEYEAR,IY,NC,ISIZE,IC,kch)  
      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   
      SUBROUTINE TRIR(ID,IYR,N,Y,NC,IFL,IU,MAX)
      CHARACTER ID*8,IDA*8,LINE*80
      INTEGER NC(MAX),IY(10),INC(10)
      REAL Y(MAX)
      SAVE
      ISBR=1
      K=1
      IF(ID(1:6) .EQ. '******')K=-1
    2 N=0
      ISW=0
      IER=0
      IFL=IFL+1
      GOTO 1
   91 IER=IER+1
      IF(IER .GT. 10)STOP'SBR TRIR OVER 10 TEXT LINES'
C     WRITE(6,'(/9X,''TITLE OF DATA: '',A80/)')LINE
    1 READ(IU,'(A80)',ERR=99,END=99)LINE
      IF(ISBR .EQ. 1)THEN
      READ(LINE,'(A6,I4,10(I4,I3))',ERR=91,END=99)
     +IDA(1:6),IYR1,(IY(I),INC(I),I=1,10)
      IDA(7:8)='  '
      ELSEIF(ISBR .EQ. 2)THEN
      READ(LINE,'(a8,I4,10I6)',ERR=91,END=99)IDA,IYR1,IY
      ENDIF
      ISW=ISW+1
      L=10
      IF(ISW .EQ. 1)THEN
      ID=IDA
      IYR=IYR1
      IF(IYR .GE. 0)THEN
      L=10-MOD(IYR,10)
      ELSE
      L=ABS(MOD(IYR,10))
      IF(L .EQ. 0)L=10
      ENDIF
      ENDIF
      IF(ISBR .EQ. 2)GOTO3
      L=11-L
      DO 10 I=L,10
      IF(IY(I) .LT. 9990 .AND. N .LT. MAX)THEN
      N=N+1
      Y(N)=FLOAT(IY(I))
      IF(K .GE. 0)NC(N)=INC(I)
      ELSE
      RETURN
      ENDIF
   10 CONTINUE
      IF(IYR1.EQ.1970)RETURN
      GOTO 1
   99 IFL=-999
      RETURN
*** ENTRY TRMR
      ENTRY TRMR(ID,IYR,N,Y,IFL,IU,MAX)
      ISBR=2
      GOTO 2
    3 DO 20 I=1,L
      IF(IY(I) .EQ. 999)RETURN
      IF(N .LT. MAX)THEN
      N=N+1
      Y(N)=FLOAT(IY(I))
      ENDIF
   20 CONTINUE
      GOTO 1
*** ENTRY TRIW
      ENTRY TRIW(ID,IYR,N,Y,NC,IU,MAX)
      ISBR=3
    5 IF(N .LE. 0)RETURN
      IER=0
      J=0
      KYR=IYR
      IF(ISBR .EQ. 3)THEN
      IF(IYR .GE. 0)THEN
      L=MOD(IYR,10)+1
      ELSE
      L=11-ABS(MOD(IYR,10))
      IF(L .EQ. 11)L=1
      ENDIF
   32 DO 30 I=1,10
      IY(I)=9990
   30 INC(I)=0
      DO 40 I=L,10
      J=J+1
      IF(J .GT. N)THEN
      J=-999
      GOTO 41
      ENDIF
      IF(NC(1) .GT. 0)THEN
      INC(I)=NC(J)
      ELSE
      INC(I)=1
      ENDIF
      IY(I)=NINT(Y(J)*1000.)
      IF(IY(I) .GE. 9990)THEN
      IY(I)=9989
      IF(IER .EQ. 0)WRITE(6,'(/6X,''>> SBR TRIW: SERIES '',A8,
     +'' LARGER VALUE REDUCED TO 9.989''/)')ID
      IER=IER+1
      ENDIF
   40 CONTINUE
   41 WRITE(IU,'(A6,I4,10(I4,I3))')
     +ID(1:6),KYR,(IY(K),INC(K),K=1,10)
      IF(J .LT. 0)RETURN
      KYR=KYR-L+11
      L=1
      GOTO 32
      ELSEIF(ISBR .EQ. 4)THEN
      GOTO 4
      ENDIF
*** ENTRY TRMW
      ENTRY TRMW(ID,IYR,N,Y,IU,MAX)
      ISBR=4
      GOTO 5
    4 IF(IYR .GE. 0)THEN
      L=10-MOD(IYR,10)
      ELSE
      L=ABS(MOD(IYR,10))
      IF(L .EQ. 0)L=10
      ENDIF
   42 DO 50 I=1,L
      J=J+1
      IF(J .GT. N)THEN
      IY(I)=999
      L=I
      J=-999
      GOTO 51
      ELSE
      IY(I)=NINT(Y(J)*100.)
      IF(IY(I) .EQ. 999)IY(I)=998
      ENDIF
   50 CONTINUE
   51 WRITE(IU,'(A8,I4,10I6)')ID,KYR,(IY(K),K=1,L)
      IF(J .LT. 0)RETURN
      KYR=KYR+L
      L=10
      GOTO 42
      END