C T.L.Gulyaeva...........................................Dec 2010
C hcF2 
C
C Input files stYRMN.txt $ 
C                          stYRMNg.txt (fcF2// from TECgps)
C & styrf.br(from IDCE) 	????????????????
C
C <<< to replace only line(s) for given day(s)
C 
C Output: annual file stYRf.br for Conver & /dat8/10/styrmn.txt
C
      PROGRAM DECODHF
C---------------------------------------------------------------
C data for 24 UT=0,1,2,...23hUT daily
C
C
C*********TEST
	CHARACTER*128 INFILE1,INFILE2,OUTFILE,OUTFILEF,TXT
		CHARACTER*120 XXX,YYY(62),ZZZ,FFF(31)
c	CHARACTER*4 AYEAR
	character*2 ayr,amn,byr,bmn,bdy,ST,sts(65),CC(0:23),BB,AA
	+,DY1,DY2,DY
c	+,ady
	INTEGER*2 IDY
	character*1 n1
c	+,NST(0:9)
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*6	YYMMDD
	+,YMD(62),FMD(31)
	CHARACTER*3 fin1(0:23),fin2(0:23)
	dimension im(12)

	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
c	DATA NST/'0','1','2','3','4','5','6','7','8','9'/
	DATA STS
	+/'as','at','bp','bc','br','cb','ch','cn','cq','cs'
     +,'cw','dw','ea','eb','db','gm','ga','gr','gu','ha'
     +,'he','ho','ic','jm','ir','jr','jj','kh','kk','kw'
     +,'lg','lm','mg','ml','mh','mo','no','ok','ks','pq'
     +,'ro','rv','sd','ss','sq','qn','tk','tr','tv','wk'
     +,'wp','wz','yk','yg','mw','ns','tz','mq','ps','mm'
     +,'pe','rm','ni','nd','so'/

C
	IRUN=1	 ! 1 for foF2, 2 for hmF2
	BB='//'
c
	      CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
  201	      WRITE(*,*)' ENTER yr,mn :'
		READ(*,15) AYR,AMN
   15	FORMAT(A2)
  202	      WRITE(*,*)' ENTER DY1,DY2 :'
		READ(*,15) DY1,DY2
	read(ayr,*) yr
	iyr=int(yr)
	if(int(yr/4.)*4.eq.iyr) THEN 
	im(2)=29
	ndnr=366
	                          ELSE
	IM(2)=28
	ndnr=365
	ENDIF
	read(amn,*) xmn
	mn=int(xmn)
		read(dy1,*) xdy1
 	idy1=int(xdy1)
		read(dy2,*) xdy2
 	idy2=int(xdy2)


c	idy1=1
c	idy2=im(mn)
c	nds=im(mn)
cc	nds=idy2-idy1+1
C
C start foF2 or hmF2
  199	nds=idy2
C    
  	if (irun.eq.1) then
	infile1='d:\web\dat1\10\styrmn.txt'   !f
	infile2='d:\web\dat8\10\styrmng.txt'
	outfile='d:\web\graf\2010\styrf.br'		! Insert new lines in file .br
      outfilef='d:\web\dat8\10\styrmn.txt'
	else
	infile1='d:\web\dat6\10\styrmnh.txt'   !h
	infile2='d:\web\dat9\10\styrmnz.txt'   !h
	outfile='d:\web\graf\2010\styrh.br'		! Insert new lines in file .br
      outfilef='d:\web\dat9\10\styrmnh.txt'	!h
	endif
	infile1(13:14)=ayr
	infile2(13:14)=ayr
	outfile(15:16)=ayr

	infile1(18:19)=ayr
	infile2(18:19)=ayr
	outfile(20:21)=ayr

	infile1(20:21)=amn
	infile2(20:21)=amn

	outfilef(13:14)=ayr
	outfilef(18:19)=ayr
	outfilef(20:21)=amn
C
C start cycle on stations
	DO 88 jj=1,65
	st=sts(jj)
c	if (jj.lt.65) goto 88   ! last station only
	infile1(16:17)=st
	infile2(16:17)=st
	outfile(18:19)=st
c outfilef='d:\web\dat8\10\styrmn.txt'
c-	outfilef=infile1
	outfilef(16:17)=st
c outfilef(24:25)='res'

c	
	OPEN(110,FILE=outfile)
	OPEN(109,FILE=outfilef)	  
C
C Read stYRf.br data:
   78	read(110,18,END=79,ERR=2) YYMMDD,XXX
	YYY(62)=XXX
	YMD(62)=YYMMDD
C Shift data 1 line ahead:
	do k=1,61
	YYY(k)=YYY(k+1)
	YMD(k)=YMD(k+1)
	enddo
	goto 78
  79	continue
	close(unit=110)
		OPEN(110,FILE=outfile)
c	write(*,18) yymmdd,xxx
c
c	write(*,109) st,ayear,amn
c	write(110,109) st,ayear,amn
c  109	FORMAT(1X,2(1X,A2),1X,A4,1X,A2)
C
		    OPEN(111,FILE=INFILE1)
	 OPEN(112,FILE=INFILE2)
c ***************************************************************
C	  Read 1st array:
   17 format(A128)
   18	format(A6,2X,A120)
  107	FORMAT(3A2,2X,24(A3,2X))
  108	FORMAT(3A2,2X,24(A3,A2))
	do m=1,4
	read(111,17,err=2,end=81) txt ! header line
	write(109,17) txt
	read(112,17,err=2,end=81) txt ! header line
	enddo
C
	DO i=1,31
	FMD(i)='      '
	ENDDO
C
	nn=0
	iflag=0
C Reading 1st file + count line number
	do kk=1,31
	READ (111,18,END=77,ERR=2) YYMMDD,XXX  ! infile 1 - foF2
	nn=nn+1
	FMD(kk)=YYMMDD
	FFF(kk)=XXX
	enddo
   77	continue
	if (nn.lt.idy2) then 
C++
	do kk=nn+1,idy2
	YYMMDD=FMD(kk-1)
	DY=YYMMDD(5:6)
	read(dy,*) rdy
	idy=int(rdy)
	idy=idy+1
		call blet2(idy,dy)             !
	YYMMDD(5:6)=DY
	FMD(kk)=YYMMDD
		do k=0,23
	k1=k*5+1
	k2=k1+2
	fin1(k)=xxx(k1:k2)
	k3=k2+1
	k4=k3+1
	fin1(k)='  0'
 	cc(k)='* '
	ZZZ(k1:k2)=fin1(k)
	ZZZ(k3:k4)=cc(k)
	   enddo

	FFF(kk)=ZZZ
	enddo 
C+++
	nn=idy2	   ! 
	endif
   	do 80 ii=1,31     ! count day number					             !!

	YYMMDD=FMD(ii)
	XXX=FFF(ii)
C 
	 ZZZ=XXX     ! keep current line of foF2
	do k=0,23
	k1=k*5+1
	k2=k1+2
	fin1(k)=xxx(k1:k2)
	k3=k2+1
	k4=k3+1
	cc(k)=xxx(k3:k4)
	enddo

c										   infile 2 - foF2gps
	READ (112,107,END=75,ERR=2) byr,bmn,bdy,(fin2(k),k=0,23)
	do i=0,23
	aa=cc(i)
	n1=aa(1:1)
	 i1=i*5+1
	i2=i1+2
	i3=i2+1
	i4=i3+1
cc      	if ((n1.eq.'*').or.(n1.eq.'/')) then
      if ((n1.eq.'*').or.(n1.eq.'/').or.(fin1(i).eq.'  0')
	+.or.(fin1(i).eq.' 00').or.(fin1(i).eq.'000').or.(fin1(i).eq.'   ')
     +) then
	fin1(i)=fin2(i)
	aa(1:1)='/'
	if (aa(2:2).eq.' ') aa=bb
	cc(i)=aa
	endif
	zzz(i1:i2)=fin1(i)
	zzz(i3:i4)=cc(i)
	enddo
C keep results at the proper line of styrf.br & stYRMN.txt files:
  75	do m=1,31
	if (yymmdd.eq.ymd(m)) then
	YYY(m)=ZZZ
	endif
	if (yymmdd.eq.fmd(m)) then
	FFF(m)=ZZZ
	endif
	enddo
C output corrected line
c-	write(*,108) byr,bmn,bdy,(fin1(k),cc(k),k=0,23)
c-	write(109,108) byr,bmn,bdy,(fin1(k),cc(k),k=0,23)
   80	continue
	do m=1,61
cc	write(*,18) YMD(m),YYY(m)
cc	write(110,18) YMD(m),YYY(m)
	if (m.le.nn) then
	write(*,18) FMD(m),FFF(m)
      write(109,18) FMD(m),FFF(m)
	endif
	enddo
   81	close(unit=111)
   82	close(unit=112)
C
	close(unit=109)
	close(unit=110)
  88	continue								 !!
c   98	format(1X,I3,2(F5.1,1X))
	if (irun.eq.1) then
	irun=2
	goto 199
	               else
	GOTO 33
	endif
C
c  183			write(*,*) ' month=',xmn
c	xmn=xmn+1.
c      imn=imn+1
c	xdy=1.
C --------------- 
c		close(unit=113)
    2 CONTINUE
c-      if (irun.eq.0) then
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
 	pause ' '
	goto 34
c-      endif

   33	continue
      write(*,*) infile1,infile2,outfile
      pause ' ' 
   34   STOP
       END

C***********************************************************
      subroutine blet2(ilet,alet2)
c     nn=1,2,3,4 

	CHARACTER*1 IN(0:9)
	INTEGER*2 ilet
	DATA IN/'0','1','2','3','4','5','6','7','8','9'/
	CHARACTER*2 alet2
CLjuba	a2='00'
	alet2='00'             !NEW+7
	j10=ilet/10
	j1=ilet-j10*10
    5	do i=0,9
	if (j10.eq.i) then
	alet2(1:1)=IN(i)
	endif
	enddo
   7	do i=0,9 
     	if (j1.eq.i) then
 	alet2(2:2)=IN(i)
	endif
	enddo 
	return
	end
