	program extsao6
c "CONVMOS1" EXTRACT foF2 <dat(1)> & M3000F2 <dat(3)> FROM DAILY-HOURLY FILE DPS SAO FILE, 
C extract also hmF2 <dat(32), ITEC <dat(39)>, Hscbot <dat(40)>
C Dourbes <db>
	DIMENSION im(12),dat(49),XX(15)
	INTEGER*2 jyr,jmn,jdy
	INTEGER count
	CHARACTER*128 infile,outfile1,outfile2,outfile3
	+,infile1,infile2,infile3
c-	+,outfile4,outfile5
      	CHARACTER*16 TXT
 	CHARACTER*4 AYEAR,XLET4,CYEAR

	CHARACTER*13 DD1,CC1
	CHARACTER*2 AYR,AMN,ADY,ST,AMN_pre,DY1
	+,TT,AUT,CUT,CYR,CMN,CDY
       CHARACTER*128 m_data
	CHARACTER*5 DATF(0:31,24),DATM(0:31,24),XFOF2,XMF2,XHF2,XTEC,XSC
	+,DATH(0:31,24),DATT(0:31,24),DATS(0:31,24)
	CHARACTER*3 DOY,XLET3
c	CHARACTER*6 YYMMDD 
	CHARACTER*1 AMM
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
       write(*,*) 'Enter ST '
	read(*,22) ST

CREM	st='db'
C
c-     write(*,*) 'Enter YYMMDD'
c-    read(*,19) YYMMDD
       write(*,*) 'Enter YEAR'
Ctemp	read(*,21) AYEAR
	AYEAR='2020'
Ctemp	AYR=YYMMDD(1:2)
	AYR=AYEAR(3:4)
	read(ayr,*) ryr
	jyr=int(ryr)
C
 134    write(*,*) 'Enter MN (MN=00 for stop)'
	read(*,22) AMN
	if (amn.eq.'00') STOP
Ctemp	AMN='03'
	read(amn,*) rmn
	jmn=int(rmn)
	if (jmn.gt.12) STOP
C
	if(int(ryr/4.)*4.eq.jyr) THEN 
 	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF
Ctemp	AMN=YYMMDD(3:4)
       write(*,*) 'Enter DY start,DY end'
	read(*,*) KDY,KDY2
	jj=kdy
Ctemp      kdy=0
	call blet2(kdy,DY1)
	if (kdy.eq.1) then 
	jmn_pre=jmn-1
	else
	jmn_pre=jmn
	endif
	call blet2(jmn_pre,AMN_pre)
C
	kdy=kdy-1
  135	kdy=kdy+1
ctemp      if (kdy.gt.im(jmn)) goto 134
      if (kdy.gt.kdy2) goto 134
      call blet2(kdy,ADY)
Ctemp	ADY=YYMMDD(5:6)
C Next line : specify MONTH from current date:
	read(ady,*) rdy
	jdy=int(rdy)

C Calculate day-of-year:
	lday=ndoy(jyr,jmn,jdy) ! function to define day-of-year
	call blet3(lday,DOY)

	write(*,17) doy

C
	DD1='FF20140561002'	   ! temp
	IF (st.eq.'ea') dd1(1:2)='FE'
	IF (st.eq.'eb') dd1(1:2)='FF'
	IF (st.eq.'bp') dd1(1:2)='AA'
	IF (st.eq.'cq') dd1(1:2)='AA'
	IF (st.eq.'gu') dd1(1:2)='AA'
	IF (st.eq.'ha') dd1(1:2)='AA'
	IF (st.eq.'ml') dd1(1:2)='AA'
	DD1(5:6)=AYR
	DD1(7:9)=DOY
	DD1(10:11)=AMN
	DD1(12:13)=ADY

	DO i=1,24
	datf(1,i)=' 00  '
	datm(1,i)='000  '
	dath(1,i)='000  '
	datt(1,i)=' 000 '
	dats(1,i)=' 00  '
	ENDDO
c
C Next line : specify YEAR from current date:
	AYEAR=DD1(3:6)
C ==========================================================
C
c+	 Next lines = specify path and name of Output file:
	 outfile1='d:/web/graf/2016/db13f.br'
	outfile1(18:19)=st
	outfile1(13:16)=AYEAR
	outfile1(20:21)=AYR			  ! foF2
	outfile2=outfile1
	    outfile2(22:22)='m'		  ! M3000F2
	outfile3=outfile1
	    outfile3(22:22)='h'		  ! hmF2
c-	outfile4=outfile1
c-		outfile4(17:17)='t'		  ! Itec
c-	outfile5=outfile1
c-		outfile5(17:17)='s'		  ! Hscbot
C ==========================================================
      if (st.eq.'eb') then
 	INFILE='d:\web\graf\EB\eb040_2020056.SAO' !
	else
 	INFILE='d:\web\graf\DB\DB049_2013056000000.SAO' ! temp CHINESE
	endif

	infile(13:14)=st
	infile(16:17)=st
	if (st.eq.'ea') infile(18:20)='036'
	if (st.eq.'eb') infile(18:20)='040'
	if (st.eq.'bp') infile(18:20)='440'
	if (st.eq.'cq') infile(16:20)='09429'
	if (st.eq.'gu') infile(18:20)='421'
	if (st.eq.'ml') infile(18:20)='449'
	INFILE(22:25)=AYEAR
	INFILE(26:28)=DOY
C ==========================================================
c-	OPEN(11,FILE=OUTFILE1)
c-	OPEN(12,FILE=OUTFILE2)
c-	OPEN(13,FILE=OUTFILE3)
      infile1=outfile1
	infile2=outfile2
	infile3=outfile3
C+++++++++++++++++++++++++++++++++++++
	if (kdy.gt.jj) goto	1555
  333 FORMAT(a128)
C Read data before prec. day:
	OPEN(33,FILE=INFILE1)
	count=0
   55	READ(33, 333, END=44) m_data 
	CYR=m_data(1:2)
	CMN=m_data(3:4)
	CDY=m_data(5:6)
	if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then  
 	goto 44
	                  else
         count=count+1
      GOTO 55
      CONTINUE
                  	endif
   44 m_strings = count
	REWIND (33)
      count=0
      do while (count.lt.m_strings)
	           READ(33, 333, END=444) m_data 
         count=count+1
      enddo
  444 print*,'YES!'
      ENDFILE 33
      close(UNIT=33)
C
      count=0
	OPEN(33,FILE=INFILE2)
  155	READ(33, 333, END=144) m_data 
	CYR=m_data(1:2)
	CMN=m_data(3:4)
	CDY=m_data(5:6)
	if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then  
 	goto 144
	                  else
         count=count+1
      GOTO 155
      CONTINUE
                  	endif
  144 m_strings = count
	REWIND (33)
      count=0
      do while (count.lt.m_strings)
	           READ(33, 333, END=555) m_data 
         count=count+1
      enddo
  555 print*,'YES!'
      ENDFILE 33
      close(UNIT=33)
C
      count=0
	OPEN(33,FILE=INFILE3)
  255	READ(33, 333, END=244) m_data 
	CYR=m_data(1:2)
	CMN=m_data(3:4)
	CDY=m_data(5:6)
	if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then  
 	goto 244
	                  else
         count=count+1
      GOTO 255
      CONTINUE
                  	endif
  244 m_strings = count
	REWIND (33)
      count=0
      do while (count.lt.m_strings)
	           READ(33, 333, END=556) m_data 
         count=count+1
      enddo
  556 print*,'YES!'
      ENDFILE 33
      close(UNIT=33)
C
 1555	OPEN(11,FILE=OUTFILE1,ACCESS='APPEND')
	OPEN(12,FILE=OUTFILE2,ACCESS='APPEND')
	OPEN(13,FILE=OUTFILE3,ACCESS='APPEND')
c-	OPEN(14,FILE=OUTFILE4,ACCESS='APPEND')
c-	OPEN(15,FILE=OUTFILE5,ACCESS='APPEND')
c
cc    		OPEN(10,FILE=INFILE,ACTION='READ')
   17	FORMAT(1X,'DOY='A3)
   19	format(A6)
cc   20	format(A13,A2,A1)
cc   20	format(A13,I2,A1)
   20	format(A16)
   21	format(A4)
   22	format(A2)
   23	format(15(F8.3))

	AUT='00'
	j1=1
C ==========================================================
   1	do 77 iut=1,24               ! cycle on UT
	jut=iut-1
	call blet2(jut,AUT)
	 xfoF2=' 00  '
	XMF2='000  '
	XHF2='000  '
	XTEC=' 000 '
	XSC='000  '
cc	    		OPEN(10,FILE=INFILE,ACTION='READ')
	    		OPEN(10,FILE=INFILE)
cc  100	read(10,20,err=3,end=107) CC1,ICUT,AMM
cc  100	read(10,20,err=3,end=107) TXT
  100	read(10,20,err=3,end=115) TXT
	CUT=txt(1:2)
	CYEAR=TXT(3:6)
	IF (CYEAR.EQ.AYEAR) then
c	if (CUT.eq.'FF') then
	cc1=txt(1:13)
	cut=txt(14:15)
	AMM=txt(16:16)
	read(cut,*) tut
	icut=int(tut)
	goto 9
	else
	goto 100
	endif
   10	continue
	 TT=CC1(1:2)
	if (TT.eq.' ') then
	goto 3
	endif
    9  continue 
cc 	if ((cc1.eq.dd1).and.(CUT.eq.AUT).and.(AMM.eq.'0')) then 
 	if ((cc1.eq.dd1).and.(ICUT.eq.JUT)) then 
	goto 101			! select UT-hourly values
	else
	goto 100
	endif
  101 continue
	jj=0
      DO n=1,4
	read(10,23,end=111,err=2) (xx(k),k=1,15)
	do k=1,15
	if (xx(k).gt.999.) xx(k)=0.
	jj=jj+1
	dat(jj)=xx(k)
	enddo
	ENDDO  
C	 XFOF2,XMF2,XHF2,XTEC,XSC
C ==========================================================
  111	ifof2=nint(dat(1)*10.)	 ! foF2*10
	m3f2=nint(dat(3)*100.)	 ! m3000*100
	ihf2=nint(dat(32))		 ! km
	itec=nint(dat(39)*10.)  ! TECU*10
	isc=nint(dat(40))       ! Hscbot km
C Change input for SAO format at MOS:===============
	if (ifof2.eq.0) goto 107
	call blet3(ifof2,XLET3)
	if (xlet3(1:1).eq.'0') xlet3(1:1)=' '
	XFOF2(1:3)=XLET3
	call blet3(m3f2,XLET3)
	XMF2(1:3)=XLET3
	call blet3(ihf2,XLET3)
	XHF2(1:3)=XLET3
	call blet4(itec,XLET4)
	if ((xlet4(1:1).eq.' ').and.(xlet4(2:2).eq.'0')) xlet4(2:2)=' '
 	XTEC(1:4)=XLET4
	call blet3(isc,XLET3)
	if (xlet3(1:1).eq.'0') xlet3(1:1)=' '
 	XSC(1:3)=XLET3

 
C ========================================
   11	continue

  107	 datf(j1,iut)=xfof2
	  datm(j1,iut)=xmf2 
	  dath(j1,iut)=xhf2 
      datt(j1,iut)=xtec
      dats(j1,iut)=xsc 
  440 CLOSE (unit=10)
  77	continue           ! End of UT cycle
c
c

C115	DO J=1,JJ
  115	j=1
	write(11,180) ayr,amn,ady,(datf(j,k),k=1,24)
	write(*,180) ayr,amn,ady,(datf(j,k),k=1,24)
		write(12,180) ayr,amn,ady,(datm(j,k),k=1,24)
 	write(*,180) ayr,amn,ady,(datm(j,k),k=1,24)
		write(13,180) ayr,amn,ady,(dath(j,k),k=1,24)
 	write(*,180) ayr,amn,ady,(dath(j,k),k=1,24)
c-		write(14,180) ayr,amn,ady,(datt(j,k),k=1,24)
c-	write(*,180) ayr,amn,ady,(datt(j,k),k=1,24)
c-		write(15,180) ayr,amn,ady,(dats(j,k),k=1,24)
c- 	write(*,180) ayr,amn,ady,(dats(j,k),k=1,24)


C	ENDDO

  180	format(3A2,2X,24(A5))
C
rem	pause ' '
	goto 2
    3	 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
	write(*,*) infile
c	pause ' '
c	datf(jj,jut)=' 00  '
c      datm(jj,jut)=' 000 '
c	goto 1110
   2      CLOSE (unit=11)
      CLOSE (unit=12)
      CLOSE (unit=13)
c-      CLOSE (unit=14)
c-      CLOSE (unit=15)

	write(*,*) infile
	pause ' '
	goto 135
C
      STOP
	END
C ===============================================================
C ===============================================================
