C =======================================================
	SUBROUTINE SUBSGO2ac(kdy1,kdy2,ady,datf,datm)
C......................................................................Aug. 2015
C insert former values foF2 
c 10 REM "CONV-SGO" EXTRACT FOF2 FROM SGO DAILY FILE
C Add extract M3000F2 from SGO file 
	DIMENSION xf2(0:23),xm3(0:23),xhm(0:23) ! daily sets for UT=0,...,23
C	INTEGER*2 ID1,ID2,jdy
      CHARACTER*128 infile,outfilef,outfilem,outfileh,txt
	+,txtf,txtm,txth,infilef2,infileh2
 	CHARACTER*4 YEAR,TEXF,TEXM,TITLE,TTT
	CHARACTER*2 YR,AMN,ST,DY1,DY2,DDD,ADY(0:31),DD1,DD2,DY22
	+,CYR,CMN,CDY,BYR,BMN,BDY,AUT
c???     +,cdy0,cmn0,cyr0
       CHARACTER*3 XXX,ahmf2
      CHARACTER*30 STNAME
      CHARACTER*13 STAT
	CHARACTER(10) DD
	CHARACTER*5 DATF(0:31,0:23),DATM(0:31,0:23),ZZ,XXXXX
	+,DATH(0:31,0:23)   ! UT=0,...23
	+,XXXF2(0:23),XXXH2(0:23)
	COMMON /BL1/ST,YEAR,YR,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22
	+,STNAME
		COMMON /BL2/ STAT,GLAT,GLON,DD,TTT,ZZ,R12
	
C
      glat=67.4  
	 glon=26.6
C	read(dy1,*) d1
	id1=kdy1
C	read(dy2,*) d2
	id2=kdy2
	do i=0,31
	ADY(i)='00'
	enddo

	TEXF='FOF1'
      TEXM='FXI '
		XXXXX=' 00  '
	DO k=id1,id2
	DO i=0,23
	datf(k,i)=XXXXX
	datm(k,i)=XXXXX
	dath(k,i)=XXXXX
	ENDDO
	enddo
	YR=YEAR(3:4)
C
	idd=id1
	infile='c:\web\graf\fin\YEARMNDY.txt'
	infile(17:20)=YEAR
	infile(21:22)=amn
	outfilef='c:\web\graf\YEAR\soyrf.br'
	outfilef(13:16)=YEAR
	outfilef(20:21)=YR
	outfilem=outfilef
	outfilem(22:22)='m'
	outfileh=outfilef
	outfileh(22:22)='h'
	open(12,file=outfilef)
	open(13,file=outfilem)
	open(14,file=outfileh)

C++
      infilef2='c:\web\graf\dat1\YR\soyrmn.txt' 
	infileh2='c:\web\graf\dat6\YR\soyrmnh.txt' 
	infilef2(18:19)=YR
	infilef2(23:24)=YR
	infilef2(25:26)=AMN
	infileh2(18:19)=YR
	infileh2(23:24)=YR
	infileh2(25:26)=AMN
	OPEN(15,file=infilef2,action='READ')
	OPEN(16,file=infileh2,action='READ')
  333	format(A128)
C foF2
	icount=0
   55 READ(12,333,END=44) txt
 	CYR=txt(1:2)
	CMN=txt(3:4)
	CDY=txt(5:6)
	if ((cyr.eq.yr).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then  
	goto 44
	                  else
         icount=icount+1
      GOTO 55
      CONTINUE
                  	endif
C+   44 mf_strings = icount
   44 mf_strings = icount-1
       REWIND (12)
      icount=0
      do while (icount.lt.mf_strings) ! remenber prec_DY1 lime
         READ(12, 333, END=444) txtf
         icount=icount+1
      enddo
  444 print*,'YES!'
      ENDFILE 12
      close(UNIT=12)
C  M3000
	icount=0
  155 READ(13,333,END=144) txt
 	CYR=txt(1:2)
	CMN=txt(3:4)
	CDY=txt(5:6)
	if ((cyr.eq.yr).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then  
	goto 144
	                  else
		icount=icount+1
      GOTO 155
      CONTINUE
                  	endif
C++  144 mm_strings = icount
  144 mm_strings = icount-1
       REWIND (13)
      icount=0
      do while (icount.lt.mm_strings)
         READ(13, 333, END=445) txtm	 ! remenber prec_DY1 lime
         icount=icount+1
      enddo
  445 print*,'YES!'
      ENDFILE 13
      close(UNIT=13)
C hmF2
	icount=0
  255 READ(14,333,END=244) txt
 	CYR=txt(1:2)
	CMN=txt(3:4)
	CDY=txt(5:6)
	if ((cyr.eq.yr).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then  
	goto 244
	                  else
         icount=icount+1
      GOTO 255
      CONTINUE
                  	endif
C  244 mh_strings = icount
  244 mh_strings = icount-1
       REWIND (14)
      icount=0
      do while (icount.lt.mh_strings)
         READ(14, 333, END=446) txth	! remenber prec_DY1 lime
         icount=icount+1
      enddo
  446 print*,'YES!'
      ENDFILE 14
      close(UNIT=14)
C
	do iut=0,23
	k1=9+iut*5	   ! prec_DY1 data
	k2=k1+4
	if (iut.lt.22) then
	 xxxxx=txth(k1:k2)
	dath(id1-1,iut)=xxxxx
	 xxxxx=txtf(k1:k2)
	datf(id1-1,iut)=xxxxx
	 xxxxx=txtm(k1:k2)
	datm(id1-1,iut)=xxxxx
	endif
	enddo

C ==========================================================
   1	do 77 jdy=id1,id2               ! cycle day-by-day
	call blet2(jdy,DDD)
	infile(23:24)=ddd
	ADY(jdy)=ddd
	ifl=0
    		OPEN(111,FILE=INFILE)
   10	read (111,160,err=440,end=224) title
	goto 225
  224	title=' '
	goto 440
  160	format(2X,A4)
  225	if (title.eq.texf) then
	ifl=ifl+1
	goto 11
	                      else
	goto 10
	                       endif
   11	continue
	if (ifl.eq.1) then
   	read (111,170,err=3,end=440) (datf(jdy,k),k=0,11)
  170	format(7X,12(2X,A5))
c--	write(*,171) (datf(jdy,k),k=0,11)
  171	format(12(2X,A5))
  172	format(3A2,2X,24(A5))
	read (111,160,err=3,end=440) title      ! one extra line
	read (111,170,err=3,end=440) (datm(jdy,k),k=0,11)
c--		write(*,171) (datm(jdy,k),k=0,11)
	goto 10
	else
	   	read (111,170,err=3,end=77) (datf(jdy,k),k=12,23)
c--	write(*,171) (datf(jdy,k),k=12,23)
C
		read (111,160,err=3,end=440) title      ! one extra line
 	read (111,170,err=3,end=2) (datm(jdy,k),k=12,23)
c      write(*,171) (datf(jdy,k),k=0,23)	!++
c	write(*,171) (datm(jdy,k),k=0,23)	!++

c-	pause ' '
	endif
  440 CLOSE (unit=111)
	if (title.eq.' ') goto 77
C
C Produce hmF2
C
	icnt0=0
	do 222 lt=0,23       ! foF2, M3000 in LT
	iut=lt-2
	if (iut.lt.0) iut=iut+24
	XXXXX='000  '
	XXXXX=datf(jdy,lt)
	XXX=XXXXX(1:3)
	if (XXX(1:1).eq.' ') XXX(1:1)='0'
	if (XXX(2:2).eq.' ') XXX(2:2)='0'
	if (XXX(3:3).eq.' ') XXX(3:3)='0'
	read(XXX,*) rrr
	xf2(iut)=rrr/10.
	if (rrr.eq.0.) icnt0=icnt0+1
C
	XXXXX=datm(jdy,lt)
	XXX=XXXXX(1:3)
	if (XXX(1:1).eq.' ') XXX(1:1)='0'
	if (XXX(2:2).eq.' ') XXX(2:2)='0'
	if (XXX(3:3).eq.' ') XXX(3:3)='0'
	read(XXX,*) rrr
	xm3(iut)=rrr/100.
	xhm(iut)=0.
c==  	enddo
  222	CONTINUE
C
	if (icnt0.eq.24) goto 223 ! no foF2 data
	alat=67.4
	along=26.6
c-	xmagbr=65.5
	call subhmf2(alat,along,jdy,xf2,xm3,xhm)

  223	do iut=0,23
	ihmf2=nint(xhm(iut))
	call blet3(ihmf2,ahmf2)
	xxxxx(1:3)=ahmf2
	xxxxx(4:5)='  '
	if (iut.lt.2) then
	dath(jdy-1,iut+22)=xxxxx
	else
	dath(jdy,iut-2)=xxxxx
	endif
	enddo

   77	enddo			  ! End of reading cycle
C
C	output of 	results
  			OPEN(12,FILE=OUTFILEF,ACCESS='APPEND')
 	OPEN(13,FILE=OUTFILEM,ACCESS='APPEND')
	OPEN(14,FILE=OUTFILEH,ACCESS='APPEND')

C
crem	do j=1,jdy				! Start of output
	do j=id1,id2				! Start of output
	datf(j-1,22)=datf(j,0)	! Shift from LT to UT   foF2
	datf(j-1,23)=datf(j,1)	! Shift from LT to UT   foF2
		datm(j-1,22)=datm(j,0)	! Shift from LT to UT   M3000
	datm(j-1,23)=datm(j,1)	! Shift from LT to UT   M3000
	do i=0,21
	datf(j,i)=datf(j,i+2)		! Shift from LT to UT foF2
	datm(j,i)=datm(j,i+2)		! Shift from LT to UT M3000
	enddo
	enddo
		 datf(id2,22)='     '
		 datf(id2,23)='     '
	datm(id2,22)='     '
		 datm(id2,23)='     '
		 dath(id2,22)='     '
		 dath(id2,23)='     '
C
  173	format(3A2)
  174	format(3A2,2X,24(A5))
C output
	idmin=id1-1
	if (id1.eq.1) idmin=id1
	do jdy=idmin,id2
	call blet2(jdy,ddd)
	XXXXX=' 00  '
	DO nj=1,35
	read(15,173,end=275) BYR,BMN,BDY
	read(16,173,end=275) BYR,BMN,BDY 
	if ((BYR.eq.YR).and.(BMN.eq.AMN).and.(BDY.eq.DDD)) then
	backspace(15)
	backspace(16)
      read(15,174) BYR,BMN,BDY,(XXXF2(k),k=0,23)
	read(16,174) BYR,BMN,BDY,(XXXH2(k),k=0,23) 
	exit
	endif
	enddo
C	
275	do k=0,23
         XXXXX=datf(jdy,k)
      XXX=XXXXX(1:3)
	if (XXXXX(4:4).eq.'/') XXX='   '
	call blet2(k,AUT)
      if ((XXX.eq.'   ').or.(XXX(2:3).eq.'00')) THEN
cnorm	call subintereuc(glat,glon,yr,amn,ddd,aut,cbkf)
      call subinterfh(yr,amn,ddd,aut,icbkf,icbkh,icbkm)
C-	icbkf=nint(cbkf*10.)
	call blet3(icbkf,XXX)
	if (XXX(1:1).eq.'0') XXX(1:1)=' '
	XXXXX(1:3)=XXX
C-      XXXXX(4:4)='_'
      datf(jdy,k)=XXXXX
C
         XXXXX=dath(jdy,k)
	call blet3(icbkh,XXX)
	XXXXX(1:3)=XXX
	      XXXXX(4:4)='_'
      dath(jdy,k)=XXXXX
C
         XXXXX=datm(jdy,k)
	call blet3(icbkm,XXX)
	XXXXX(1:3)=XXX
	      XXXXX(4:4)='_'
      datm(jdy,k)=XXXXX
C
      endif
	if (datf(jdy,k).eq.'     ') datf(jdy,k)=XXXF2(k)
	if (datm(jdy,k).eq.'     ') datm(jdy,k)=XXXXX
	if (dath(jdy,k).eq.'     ') dath(jdy,k)=XXXH2(k)
	enddo
	write(*,172) yr,amn,ddd,(datf(jdy,k),k=0,23)
	write(*,172) yr,amn,ddd,(datm(jdy,k),k=0,23)
	write(*,172) yr,amn,ddd,(dath(jdy,k),k=0,23)
	write(12,172) yr,amn,ddd,(datf(jdy,k),k=0,23)
	write(13,172) yr,amn,ddd,(datm(jdy,k),k=0,23)
	write(14,172) yr,amn,ddd,(dath(jdy,k),k=0,23)
	enddo
	close(unit=12)
	close(unit=13)
	close(unit=14)
	close(unit=15)
	close(unit=16)
C
  		goto 2
    3	 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
   2   continue
      RETURN
	END