      program decodralxx
C
C......................................................................March 2020
C
C
C Decode RAL-WDC foF2 file to standard annual foF2 file
C
      DIMENSION IM(12),ndhr(31),iuth(744)
	CHARACTER*120 text,infile,outfile,title
	CHARACTER*5 CODE,blank,blanks(24),DAT(24),RDAT(744)
	CHARACTER*20 xxx
	CHARACTER*4 utime,AYEAR
	CHARACTER*2	AMN,ST
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
       
	 write(*,*) 'Enter st name: '
	read(*,30) ST
	write(*,*) 'Enter stXXX CODE: '
 	read(*,34) CODE
C
	infile='d:\web\graf\2003\CH2003f.txt'
	outfile='d:\web\graf\2003\CH2003.txt'
	infile(18:19)=ST
	outfile(18:19)=ST
C	CODE='CL424'
	UTIME='0000'
	BLANK='    C'
	do i=1,24
	BLANKS(i)=blank
	enddo

C
        OPEN(10,file=infile,action="READ")
	OPEN(11,file=outfile)
  30	format(A2)
  34	format(A5)
  31	format(A120)
   32	format(24A5)
   33	format(A4,2X,A2,2(2X,I2),1X,I3,25(2X,I2))
   35	format(A100,2X,A4,2X,A2,2X,I2,2X,I4)
C?        imn=0
   1	READ(10,31,end=44) text
	n=index(text,code)
	if (n.eq.0) goto 1
	title=text(1:100)
	READ(10,33,end=44) AYEAR,AMN,idmn,ih1,ihmn,(ndhr(k),k=1,25) ! 2nd line
C	tityrmn=text(1:20)
C	AYEAR=tityrmn(1:4)
C	AMN=tityrmn(7:8)
	if (AMN(1:1).eq.' ') AMN(1:1)='0'
	read(amn,*) rmn
	mn=int(rmn)
C
C	title(101:120)=tityrmn
	write(*,35) title,AYEAR,AMN,idmn,ihmn
	write(11,35) title,AYEAR,AMN,idmn,ihmn
C
        n_rest=idmn-25
	  		READ(10,*) (ndhr(k),k=26,idmn) !3rd line
	ihrtot=0
	do k=1,idmn
	ihrtot=ihrtot+ndhr(k)
	enddo
	ihrls=ihrtot/20
	ihr_rest=ihrtot-ihrls*20

C
	do i=1,3
	read(10,*) xxx ! extra line
	enddo
C
C read ut HRS
C
	mndy=im(mn)
	do nn=1,744
      iuth(nn)=0
	rdat(nn)=blank
	enddo
C
  37	format(20(I2,4X))
 	DO jj=1,ihrls
	j1=(jj-1)*20+1
	j2=j1+19
C   2	READ(10,31,end=44) text
      read(10,37) (iuth(k),k=j1,j2)
	ENDDO
	if (ihr_rest.gt.0) then
      read(10,37) (iuth(k),k=j2+1,ihr_rest)
	endif
C	mt=index(text,utime)
C	if (mt.gt.0) then
C	backspace(10)
C	goto 2  ! exclude lines with UT
C	backspace(10)
  38	format(24A5)
  39	format(24A5)

C Read foF2
C
       nhrls=ihrtot/24
	idat_rest=ihrtot-nhrls*24
	if (idat_rest.gt.0) then
	nread=nhrls+1
	else
	nread=nhrls
	endif
C 	DO jj=1,nhrls
 	DO jj=1,nread
	j1=(jj-1)*24+1
	j2=j1+23
      read(10,38) (rdat(k),k=j1,j2)
C	READ(10,38,end=44) text
c      do k=j1,j2
c	k1=k
c	k2=k+4
c	XXXXX=text(k1:k2)
c	rdat(k)=XXXXX
c	enddo
	ENDDO
C	idat_rest=ihrls-nhrls*24
C	if (idat_rest.gt.0) then
C	READ(10,*,end=44) text
C	j3=j2+1
C	do k=j3,ihrls
C	k1=k
C	k2=k+4
C	XXXXX=text(k1:k2)
C	rdat(k)=XXXXX
C	enddo
C	endif
C
      i1=1 
	DO idy=1,mndy
	do k=1,24
	dat(k)=blank
	enddo
	i2=i1+ndhr(idy)-1
	if (ndhr(idy).eq.0) GOTO 40
	do ii=i1,i2
	it=iuth(ii)
	dat(it+1)=rdat(ii)
      enddo
C	READ(10,31,end=44) text
   40	write(*,39) dat
      write(11,39) dat
      i1=i2+1
	ENDDO
C
	if (mndy.eq.31) goto 3
C
      if (mndy.eq.30) then
	write(11,32) blanks
	mndy=31
	goto 3
	             else
C Feb				  
	do k=1,3
	write(11,32) blanks
	enddo
	mndy=31
       endif
C
   3	if (mndy.eq.31) then
	READ(10,31,end=44) text ! med
	n=index(text,code)
	if (n.gt.0) then
	backspace(10)
	write(11,32) blanks
           else
   	write(11,31) text
	endif
	READ(10,31,end=44) text	! cnt
	n=index(text,code)
	if (n.gt.0) then
	backspace(10)
	write(11,32) blanks
	goto 1
           else
   	write(11,31) text
        endif
	do i=1,4
	read(10,31) xxx ! extra line
	enddo
	endif
C
       if (mn.lt.12) GOTO 1
   44	close(unit=10)
      close(unit=11)
	pause ' '
	STOP
	END