C........................................................Jan. 2017
C
C Fill missed observations from PRIME foF2 maps files
C .......................................................Nov 2016
C Extract fcF2 missed data => at given sites
C
C 
C Output: .inp file styrmndy.inp
C
      PROGRAM extractffill
C---------------------------------------------------------------
C data for 24 UT=0,1,2,...23hUT daily
C
C
C*********TEST
	CHARACTER*120 OUTFILEF,infilest,infilef,txt,outblank
	CHARACTER*56 txt1,txt3,txt4,txt6
	CHARACTER*16 txt2,txt5
C	character*2 ayr,amn,ST,sts(86),CDY,ix,iz(0:23),CMN,CUT	  	 !1957
c	dimension glats(86),glons(86),ixxx(0:23)					  !1957
C	character*2 ayr,amn,ST,sts(109),CDY,ix,iz(0:23),CMN,CUT	  	 !1958
	character*2 ayr,amn,ST,sts(94),CDY,ix,iz(0:23),CMN,CUT	  	 !1959
	dimension glats(94),glons(94),ixxx(0:23)					  !1958
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
c	CHARACTER*13 STAT,STATS(86)								   	 !1957
	CHARACTER*13 STAT,STATS(94)								   	 !1958
	CHARACTER*1 fh,cc,ccut(0:23)
	CHARACTER*4 AYEAR
	dimension im(12)
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA STS
c2007	+/'cb','co','cn','cr','dy','dw','gs','kk','lm','mb'
c2007	+,'mq','mw','nq','ok','rm','sq','tv','wk','wp','yg'/
c	+/'aa','ad','ag','ak','ay','bd','bg','bm','br','bu'	 !1957
c     +,'bw','ca','cb','ch','co','cp','cr','ct','cu','cw'	 !1957
c     +,'cx','cy','db','dh','di','dj','dk','dt','el','fm'	 !1957
c     +,'fr','gb','gd','hb','ho','hs','hu','ir','jo','jr'	 !1957
c     +,'ki','kk','ko','la','ld','lp','ly','ma','me','mm'	 !1957
c     +,'mo','mq','nq','nu','ok','ot','pn','po','pr','ps'	 !1957
c     +,'pt','qn','rk','rm','rv','sd','sf','si','sn','so'	 !1957
c     +,'st','sv','ta','ti','tk','tv','up','wa','wk','ws'	 !1957
c     +,'wt','xc','xg','xx','yg','yk'/	                !1957
c	+/'ad','bc','bj','bp','cb','ch','cl','cn','co','cq'	!1996
c     +,'cr','cu','db','di','dy','ea','eg','gr','gs','gu'	!1996
c     +,'ho','ir','jr','ki','kk','ld','le','ln','ly','mg'  !1996
c     +,'ml','mo','mq','mu','mw','nc','ns','ok','ot','pa'	 !1996
c     +,'pk','pq','ps','pt','py','ro','rv','sd','sf','so'	 !1996
c     +,'tk','tq','tr','tv','tz','up','va','wk','wp','wt'	 !1996
c     +,'wz'/												 !1996
c	+/'aa','ac','ad','ah','ak','ax','bc','bd','bg','bm'   !1958
c     +,'br','bu','bw','ca','cb','cc','co','cp','cr','ct'
c     +,'cu','cw','cx','cy','db','dh','di','dj','dk','dt'
c     +,'el','fi','fm','fr','gb','gh','gk','gz','hb','ho'
c     +,'hs','ht','hu','ir','jo','jr','ki','kk','ko','la'
c     +,'ld','lg','lp','lu','ly','ma','me','mm','mo','mq'
c     +,'mw','nl','nq','nu','ok','ot','pd','pn','po','pp'
c     +,'pq','ps','pt','qn','rk','rm','ro','rv','sb','sd'
c     +,'si','sl','sm','sn','so','sq','st','sv','ta','ti'
c     +,'tk','tr','tu','tv','tw','tx','up','vi','vo','wa'
c     +,'wi','wk','ws','wt','wz','xg','xh','yg','yk'/	      !1958
C
	+/'aa','ac','ad','ah','ak','ax','bc','bd','bg','bm'   !1959
     +,'br','bu','bw','ca','cb','co','cp','cr','ct','cu'
     +,'cw','cx','db','dh','di','dt','fm','fr','gb','gh'
     +,'gk','gz','ho','hs','hu','io','ir','jo','jr','ju'
     +,'kh','ki','kk','ko','ld','ly','ma','mm','mo','mu'
     +,'mw','nl','nq','nu','ok','ot','pd','po','pq','ps'
     +,'pt','qn','rk','rm','ro','rv','sd','si','sl','sm'
     +,'sn','so','sr','st','sv','sw','sz','ta','ti','tk'
     +,'tp','tv','tx','up','wa','wi','wk','ws','wt','wz'
     +,'xg','xh','yg','yk'/	      !1959
c
      cc='/'
      txt2='Date of issue:  '
      txt3='YYMMDD|UT 0    1    2    3    4    5    6    7    8    9'
	txt4='   10   11   12   13   14   15   16   17   18   19   20 '
	txt5='  21   22   23  '  
      txt6='--------------------------------------------------------'
	outblank='outblank.txt'
	OPEN(16,File=outblank,access='APPEND')
	      CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
      fh='f'
C
C read stations coordinates
	infilest='status.txt'
  76	format(1X,I2,1X,A13,A2,2X,2F6.1)
   77	format(1X,A13,A2,2X,2F6.1)
	    
	i=1
    4	OPEN(109,FILE=INFILEST,action='READ')
    5	read(109,77,end=78) stat,st,glat,glon
	if (st.eq.sts(i)) then
	write(*,76) i,stat,st,glat,glon
	glats(i)=glat
	glons(i)=glon
	stats(i)=stat
	i=i+1
	          else
	goto 5
	 endif
   78	close(unit=109)
        if (i.le.94) goto 4
C
C 
  201	continue
        WRITE(*,*)' ENTER year :'
		READ(*,15) AYEAR
C	AYEAR='1989'
        WRITE(*,*)' ENTER CMN:'
		READ(*,16) CMN
	AYR=AYEAR(3:4)
   15	FORMAT(A4)
   16	FORMAT(A2)
  202	continue
	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
C	read(amn,*) xmn
C	mn=int(xmn)
C		read(ady,*) xdy
C 	idy=int(xdy)

C start foF2, hmF2 or TEC
	idy=1  !start
  199	nds=idy
C    
c	txt(1:2)=AYR
c	txt(3:4)=AMN
c	txt(5:6)=ADY

	infilef='d:\web\graf\2007\styearf.txt'
	infilef(13:16)=AYEAR
	infilef(20:23)=AYEAR
c	infileh=infilef
c	infileh(22:22)='h'
c	infilem=infilef
c	infilem(22:22)='m'
c	infilet=infilef
c	infilet(22:22)='t'

      outfilef='d:\web\dat1\yr\styrmn.txt'
	outfilef(13:14)=ayr
	outfilef(18:19)=ayr
	
C+++++++++++++++++++++++++++++
   79	format(A13)
C
	DO 88 jj=1,94  ! stations number  NORM
c	DO 88 jj=58,67  ! stations number TEMP
C      jj=31  ! GO
C++	      jj=20  ! NS
Ctemp	DO 88 jj=20,20  ! stations number
	st=sts(jj)
	stat=stats(jj)
	glat=glats(jj)
 	glon=glons(jj)

	write(*,79) stat
	txt1=stat
	iflag=1  ! TEC input

	infilef(18:19)=st
c	infileh(18:19)=st
c	infilem(18:19)=st
c	infilet(18:19)=st
	outfilef(16:17)=st
  161	format(A13)
	    OPEN(11,FILE=INFILEF,action='READ')
C
      nstart=1
C======================================================
	DO 188 imn=1,12
	ndmn=im(imn)
	call blet2(imn,AMN)
	icnt0=0
C
C Select given month
C
	IF (AMN.ne.CMN) then 
	nstart=nstart+34
      GOTO 188
	endif
C
	outfilef(20:21)=AMN
	OPEN(110,file=outfilef)
	write(*,161) txt1
	write(110,161) txt1
	write(*,*) txt2,DD,'Time = ',TT
	write(110,*) txt2,DD,'Time = ',TT
	write(*,63) txt3,txt4,txt5
	write(110,63) txt3,txt4,txt5
	write(*,64) txt6,txt6,txt6
	write(110,64) txt6,txt6,txt6
   60	format(24(I3,A2))
   61	format(3A2,2X,24(I3,2X))  !.br
   62	format(3A2,2X,24(I3,A2))
   63	format(2A56,A16)
   64	format(2A56,A16)
   65	format(A120)
C
C Find start of given month
C
	if (nstart.gt.1) then
      DO nn=1,nstart-1
	read(11,65) txt 
	ENDDO
	endif
C
	read(11,65) txt !title line
c	read(11,*) txt !title line
C--------------------------------------------------------
       DO 189 idy=1,ndmn
C
       call blet2(idy,CDY)
	do n=0,23
	ccut(n)=' '
	enddo
C   21	read(11,61,end=17) CYR,CMN,CDY,(ixxx(k),k=0,23) !.br
   21	read(11,60,end=17) (ixxx(k),iz(k),k=0,23) !.txt
	do kk=0,23
	if (ixxx(kk).eq.0) then
	call blet2(kk,cut)
	call subinterff(fh,glat,glon,ayr,cmn,cdy,cut,res) !rem++
	if (res.lt.20.) res=0. !rem++
	ixxx(kk)=nint(res)  !rem++
	ix=iz(kk)  !rem++
	ix(1:1)='_'	   !rem++
	iz(kk)=ix	   !rem++
C                 else   !rem- before filling
C	icnt0=1			   !rem- before filling
	icnt0=icnt0+1
	endif
	enddo
	write(*,62) AYR,AMN,CDY,(ixxx(k),iz(k),k=0,23)
	write(110,62) AYR,AMN,CDY,(ixxx(k),iz(k),k=0,23)
  189	CONTINUE	 !--------------------------------------
   81	close(unit=110)
	mnhrs=ndmn*24      !rem++
      if (ndmn.lt.31) then
	nextr=31-ndmn
	do k=1,nextr
	 read(11,65) txt  ! 0_C line
	enddo
	endif
	read(11,65) txt  ! med line
	read(11,65) txt  ! count line
C	if (icnt0.eq.0) then	 !rem- before filling
	if (icnt0.eq.mnhrs) then
	write(*,*) AYR,AMN,' Blank month ',txt1,outfilef
	write(16,*) AYR,AMN,' Blank month ',txt1,outfilef
C	pause ' '
	endif
  188	CONTINUE	 !=====================================
c?	 if ((CYR.eq.AYR).and.(CMN.eq.AMN).and.(CDY.eq.ADY)) then
C?	goto 22
C?	else
C?	goto 21
C?	endif
   17	write(*,*) infilef
C	pause ' '
   22	close(unit=11)

  88	continue              ! end cycle on stations
 111	format(A6,1X,24(I4,1X))
      close(unit=10)
	GOTO 33
C
    2 CONTINUE
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
 	pause ' '
	goto 34

   33	continue
      write(*,*) outfilef
      pause ' ' 
   34   STOP
       END

C***********************************************************
