C ///////////////////////////////////////////////////////////////      
      SUBROUTINE SUBCONGSc(ist)
C.........................................................Oct. 2013
C.........................................................Feb. 2012
C
C Reconstruction of fcF2, hcF2, TEC at c.p. from maps
C
C ........................................................Dec 2009
C NOT!!! CALL subfhmed........to produce both foF2 (AARI) & hmF2 (SMI)
C
C ........................................................Sep 2009
C NOT!!! Add call SUBFMED..........to produce AARI median................
C NOT!!! +input APRZ.DAT, +CCIR.BIN
C
C NOT!!! First call SUBFMED to produce median for day=15:
C (1) for preceding month
C (2) for current month
C (3) for the next month
C Then interpolate between these medians for each given day of current month
C
C ........................................................Aug 2009
C Enter station number <ist> as formal parameter
C Use Med and -W_indices of source (isp)_file 
C                                  to produce cmed and cf2 of c.p.
C ........................................................Mar. 2007
C Include transformation of foF2*proxy(1/XHIrad.)  !!!!!!!!!!!!!
C
C Cycle on stations/data
C
C T.L.Gulyaeva ...........................................Jul. 2009

c Corrected median.(AARI).................................Sep. 2009
C
C input file (parent W index data) <c:\web\dat4\yri\scyrmni.txt> => 
C to produce output files  <c:\web\dcp1\yr\scyrmnf.txt>(c.p. to be filled) 
C                       & <c:\web\dcp2\scyrmna.txt> (c.p. median of AARI)
C                       & <c:\web\dcp4\scyrmnw.txt> (c.p. W-index)
C
C Period [id1,id2] not greater than 31 days
C ID1 - day of start of array-for-W index
C ID2 - day of end of array-for-W index
C IDC - day for CLONE (00 for STOP)
C
C
C period from ID1 to ID2 (27 prec. days) for calculation of both <x1med> and <x2med>
C Crem =============== Medians amd data of foF2  =======================
C
      DIMENSION XDAT(0:23),xhm(0:23),if2(31,0:23),ih2(31,0:23)
     +,GLATS(80),GLONS(80),CLATS(80),CLONS(80)

	 INTEGER*2 JFS(80),JHS(80),JTS(80)
	+,iyr,imn,idy,ipy,ipm,nday,iut
	integer*4 IRES(0:23)
	integer*2 ID1,ID2
	 CHARACTER*2 AYR,AMN,SS(0:23),ADY
	+,STS(80),DY22,AMNS(80),sta,XMN,XDY,XYR
	+,DY1,DY2,CMN,CDY,dd1,dd2,YY
	+,PD,PY,PM,AUT,ST
      CHARACTER*128 INFILE2
	+,INFILE1,XXX,YYY(80),XEND
	CHARACTER*4 YEAR,CYEAR,CTIME
     +,TITS(4),TITPAR,TTT
	CHARACTER*3	VVV
	CHARACTER*13 STATS(80),STAT
	CHARACTER*1 fmh,f1
		CHARACTER(10) DD
	CHARACTER(5) ZZ,YYYYY,YDAT(0:23)
C
C
	COMMON /BL1/ST,YEAR,AYR,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22
	+,STNAME
       COMMON /BL2/ STAT,GLAT,GLON,DD,TTT,ZZ,R12
	COMMON /BL3/ STATS,STS,GLATS,GLONS,JFS,JHS,II,AMNS,JTS
	COMMON /BL5/ APROX,BPROX
	COMMON /BL6/ CLATS,CLONS
	DATA TITS/'fcF2','M3F2','hcF2','TEC '/
C
	 cyear=DD(1:4)
	 cmn=DD(5:6)
	cdy=DD(7:8)			 
	ctime=TTT
	ctime(3:4)='UT'
  101 continue
C First create .br file for prec. month PM (prec. year PY) + current month AMN (current year YY)
	read(ayr,*) ryr
	iyr=int(ryr)
	read(amn,*) rmn
	imn=int(rmn)
	read(DY1,*) rdy
	idy1=int(rdy)
	read(DY2,*) rdy2
	idy2=int(rdy2)

c--	idy=idy1-1  ! last preceding day
	idy=idy1
	call blet2(idy,PD)
	 ipm=imn-1
	ipy=iyr
C for current JAN
	if (imn.eq.1) then
	ipy=ipy-1
	ipm=12
	endif
C
	call blet2(ipy,PY)
	call blet2(ipm,PM)
C+++++++++++++++++++++++++++++++++++++++++
C
C Arrange 3 cycles on fmh='f'for fcF2, 'u' for hcF2, 'p',for TECcp
C
  103 glat=clats(ist)   ! c.p.
	glon=clons(ist)   ! c.p.
	stat=stats(ist)
 	sta=sts(ist)
	write(*,*) stat,sta

	infile1='c:/web/graf/dcp1/yy/STYYPMf.txt'
   	fmh='f'		 ! 1st run of cycle
		  	f1='f'            ! for subinter
   1	CONTINUE
	infile1(27:27)=fmh
	infile1(21:22)=ST

	if (fmh.eq.'f') then
	infile1(16:16)='1'
	TITPAR=TITS(1)
	endif

	if (fmh.eq.'u') then
	infile1(16:16)='6'
	TITPAR=TITS(3)
	endif

	if (fmh.eq.'p') then
	infile1(16:16)='7'
	TITPAR=TITS(4)
	endif

	infile2=infile1     ! for current month

	infile2(18:19)=AYR
	infile2(23:24)=AYR
	infile2(25:26)=AMN
C
C Avoid input of prec. month for
C
	j1=0  ! 
C
C++
  304	nday=idy1-1
  303	nday=nday+1
 	if (nday.gt.idy2) goto 332 ! end reading new data
C new data:
 	call blet2(nday,ADY)
	do k=0,23
	ydat(k)='000  '
	xhm(k)=0.
	enddo
C
   17	FORMAT(A128)
 199	continue
      OPEN(21,FILE=infile2) !	 reading INFILE2
	jcnt=0
	 do 142 j=1,41
  	READ (21,17,END=196,ERR=212) XXX

	if (j.lt.5) then 
	goto 142  ! avoid 4 extra lines
	endif
	XYR=XXX(1:2)
	XMN=XXX(3:4)
	XDY=XXX(5:6)
	if ((xyr.eq.AYR).and.(xmn.eq.AMN).and.(xdy.eq.ADY)) goto 196 ! till prec.day
	j1=j1+1
	YYY(j-4)=XXX
	  	jcnt=jcnt+1
 142	continue
 196	close(unit=21)
c//	jend=jcnt-1
	jend=jcnt
	XEND=XXX
 117	FORMAT(A4,1X,A13,1X,'c.p.', 2X,2(1X,F5.1))
 118	FORMAT('Date of issue: ',A4,'.',A2,'.',A2,1X,'Time:',A4)
  201	format('YYMMDD|UT 0    1    2    3    4    5    6    7    8'
   	&'    9   10   11   12   13   14   15   16   17   18   19   20'
	&'   21   22   23'/'-------------------------------------------'
     &'-------------------------------------------------------------'
     &'------------------------')

      OPEN(23,FILE=infile2)  ! write here results: for DY1...DY2 
	write(23,117) TITPAR,stat,glat,glon 
c//	WRITE(23,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT
	write(23,118) CYEAR,CMN,CDY,CTIME
	write(23,201)
C++
		do j=1,jend
	XXX=YYY(j)
	XMN=XXX(3:4)
	XDY=XXX(5:6)
	if ((xmn.eq.amn).and.(xdy.eq.ady)) then 
	goto 207
	else
 	write(23,17) YYY(j)
	endif
	enddo
 207	continue
crem      close(unit=23)
C
C Reconstruction of missed data
  317 FORMAT(3I2,2X,24(A5))
  300	CONTINUE
C
c+++++++++++++++++++++
  305	continue
	iflag=0
	do 301 iut=0,23		  ! Cycle on UT	=====================
	YYYYY=ydat(iut)
	VVV=YYYYY(1:3)
	YY=YYYYY(4:5)
	SS(iut)=YY
	if (vvv(1:1).eq.' ') vvv(1:1)='0'
	if (vvv(2:2).eq.' ') vvv(2:2)='0'
	if (vvv(3:3).eq.' ') vvv(3:3)='0'
	read(vvv,*) rrr
	xdat(iut)=rrr
C 
C Reconstruction from map:
          	if (rrr.eq.0.) then
		call blet2(iut,AUT)
C
C 	call subinterj(f1,ayr,amn,ady,aut,resm) ! /graf/dfc/YY/MM/ut/...
 	call subinter1(f1,ayr,amn,ady,aut,resm)	! /web/dfs/YY/MM/...

	xdat(iut)=resm
	yy(1:1)='/'
	if (fmh.ne.'p') SS(iut)=YY
	       endif
C
  327	CONTINUE
  301	continue  ! End cycle on UT
C
  310	format(3A2,2X,24(I3,A2))
  311	format(3A2,1X,24(I4,1X))
C Record results for the day:
  335 	do kk=0,23
	ires(kk)=nint(xdat(kk))
	if (fmh.eq.'f') if2(nday,kk)=ires(kk)
c//	if (fmh.eq.'m') im3(nday,kk)=ires(kk)
	if (fmh.eq.'u') ih2(nday,kk)=ires(kk)
	enddo
	if (fmh.eq.'p') then
crem	write(*,311) ayr,amn,ady,(ires(k),k=0,23)
c//	write(22,311) ayr,amn,cdy,(ires(k),k=0,23)
	write(23,311) ayr,amn,ady,(ires(k),k=0,23)
	else
crem	write(*,310) ayr,amn,ady,(ires(k),ss(k),k=0,23)
c//	write(22,310) ayr,amn,cdy,(ires(k),ss(k),k=0,23)
	write(23,310) ayr,amn,ady,(ires(k),ss(k),k=0,23)
	endif
	close(unit=23)
	GOTO 303	  ! next day
c== 302	if (fmh.ne.'t') close(unit=11)
  302	 close(unit=11)
      goto 210
C
 211  write(*,*) 'No input datafile:',infile1
      pause ' '
	goto 210
 212	write(*,*) 'No input datafile:',infile2
      pause ' '
 210	CONTINUE
c//	close(unit=22)
 332	if (fmh.eq.'p') goto 223 ! end of calculation
	if (fmh.eq.'f') then
	fmh='u'
	  	f1='h'
	goto 1
	else
	if (fmh.eq.'u') then
	fmh='p'
	  	f1='t'
	goto 1
	endif
	endif
C	
  223	write(*,331) stat
  331	format(1X,A13)
    
crem		pause ' '
      RETURN
       END
 




