C =======================================================
	PROGRAM EXTRJAPYR1
C......................................................................Dec. 2017
C Output indtYEARf.txt format (34 lines for each month
C UT=LT+9 for kk, 0k, wk, yg
C UT=LT+3h for sw
C......................................................................Nov. 2016
C Input: annual file yse day-of-year
C......................................................................Apr. 2016
C extract values foF2, MUF and hpF2 from Japan ST files
c
C
C	DIMENSION xf2(0:23),xm3(0:23),xhm(0:23) ! daily sets for UT=0,...,23
c	INTEGER*2 idy1,idy2,jdy
      dimension im(12)
      CHARACTER*128 infile,outfilef,outfilem,outfileh,txt
	+,txtf,txtm,txth
c=     +,infilef2,infileh2
	       CHARACTER*206 txtjp
 	CHARACTER*4 YEAR,TEXF,TEXM,TEXH,TITLE,CYEAR
	CHARACTER*2 YR,AMN,ST,DY1,DDD,ADY(0:31)
	+,CYR,CMN,CDY,BYR,BMN,BDY,CJT,CJTM,AUT
       CHARACTER*3 ahmf2,afof2,am3f2
	CHARACTER*5 DATF(0:31,0:23),DATM(0:31,0:23),XXXXX
	+,DATH(0:31,0:23)   ! UT=0,...23
	+,XXXF2(0:23),XXXH2(0:23),XXXM3(0:23)
	+,X5F2,X5H2,X5M2
	 DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
  111	do i=0,31
	ADY(i)='00'
	enddo
	TEXF='foF2'
	TEXH='hpF2'
      TEXM='MUF '
		XXXXX=' 00  '
	DO k=idy1,idy2
	DO i=0,23
	datf(k,i)=XXXXX
	datm(k,i)=XXXXX
	dath(k,i)=XXXXX
	ENDDO
	enddo
C
      WRITE(*,*)' ENTER <YEAR> OF INPUT FILE :'
 	READ(*,198) YEAR
c	YEAR='2016'
	write(*,198) YEAR
C	YEAR='2008'
      	read(year,*) ryear
 	iiyr=int(ryear) 
		if(int(ryear/4.)*4.eq.iiyr) THEN 
			im(2)=29
				ndnr=366
	                          ELSE
		IM(2)=28
	ndnr=365
	ENDIF

 198	format(A4)
 199	format(A2)
	      WRITE(*,*)' ENTER <st> OF INPUT FILE :'
  	READ(*,199) st
	if (st.eq.'00') STOP

C=	      WRITE(*,*)' ENTER <MN> OF INPUT FILE :'
C=  	READ(*,199) AMN
c	AMN='01'
crem	AMN='10'
c=	      WRITE(*,*)' ENTER <DY1>,<DY2> :'
c=  	READ(*,199) DY1,DY2
c=	read(dy1,*) rdy1
c=	idy1=int(rdy1)
c=	read(dy2,*) rdy2
c=	id2=int(rdy2)

	YR=YEAR(3:4)
	read(yr,*) ryr
	iyr=int(ryr)
C
	idd=idy1
	infile='d:\web\graf\JP\stYEARy.txt'
	infile(16:17)=st
	infile(18:21)=YEAR
	outfilef='d:\web\graf\YEAR\styrf.br'
	outfilef(13:16)=YEAR
	outfilef(18:19)=st
	outfilef(20:21)=YR
	outfilem=outfilef
	outfilem(22:22)='m'
	outfileh=outfilef
	outfileh(22:22)='h'
  	lda=1
 701	CONTINUE
	open(12,file=outfilef)
	open(13,file=outfilem)
	open(14,file=outfileh)

C++
c=      infilef2='d:\web\graf\dat1\YR\soyrmn.txt' 
c=	infileh2='d:\web\graf\dat6\YR\soyrmnh.txt' 
c=	infilef2(18:19)=YR
c=	infilef2(23:24)=YR
c=	infilef2(25:26)=AMN
c=	infileh2(18:19)=YR
c=	infileh2(23:24)=YR
c=	infileh2(25:26)=AMN
C	OPEN(15,file=infilef2,action='READ')
C	OPEN(16,file=infileh2,action='READ')
	DY1='01'
  333	format(A128)
C 
C Day-to-day cycle
C??	DO 700 lda=1,ndnr
 	call submmdd(lda,iyr,imn,idy)
	call blet2(imn,AMN)
C	call blet2(idy,ADY1)

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
   44 mf_strings = icount
       REWIND (12)
      icount=0
      do while (icount.lt.mf_strings) ! remember prec_DY1 line
         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
  144 mm_strings = icount
       REWIND (13)
      icount=0
      do while (icount.lt.mm_strings)
         READ(13, 333, END=445) txtm	 ! remember prec_DY1 line
         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
  244 mh_strings = icount
       REWIND (14)
      icount=0
      do while (icount.lt.mh_strings)
         READ(14, 333, END=446) txth	! remember prec_DY1 line
         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.15) then
	 xxxxx=txth(k1:k2)
	dath(idy1-1,iut)=xxxxx
	 xxxxx=txtf(k1:k2)
	datf(idy1-1,iut)=xxxxx
	 xxxxx=txtm(k1:k2)
	datm(idy1-1,iut)=xxxxx
	endif
	enddo
C
   		OPEN(111,FILE=INFILE)
C#                       fmin  ,   foE   ,   h'E   ,   foEs  ,   h'Es  ,   fbEs  ,   foF1  ,   h'F   ,   h'F2  ,   foF2  ,   fxF2  ,   M3F2  ,   fxI   ,   hpF2  ,   fxEs  ,   ftEs  ,   fxF1  ,   FSPR  ,   MUF   ,   Es1   ,   Es2   ,   Es    ,   W     
CTO536,20160301000000:  139    ,     ----,     ----,     ----,     ----,     ----,     ----,     ----,     ----,  358    ,  418----,     ----,  418X   , 3231----,     ----,     ----,     ----,   74----, 1029----,-----G   ,-----    ,     ----,-----    

C ==========================================================
	idy1=1
	idy2=im(imn)
   1	do 77 jdy=idy1,idy2               ! cycle day-by-day
	call blet2(jdy,DDD)
C	infile(23:24)=ddd
	ADY(jdy)=ddd
	ifl=0

	DO 177 jst=0,23
	call blet2(jst,AUT)
C//    		OPEN(111,FILE=INFILE)
   10	read (111,1160,err=440,end=224) txtjp
	CYEAR=txtjp(7:10)
	CMN=txtjp(11:12)
	CDY=txtjp(13:14)
	CJT=txtjp(15:16)
	CJTM=txtjp(17:18)
	goto 225
  224	title=' '
	goto 440
  160	format(2X,A4)
 1160	format(A206)
  225	if ((CYEAR.eq.YEAR).and.(CMN.eq.AMN).and.(CDY.eq.DDD)
     +.and.(CJT.eq.AUT).and.(CJTM.eq.'00')) then
	ifl=ifl+1
	goto 11
	                      else
	goto 10
	                       endif
   11	continue
C??	if (ifl.eq.1) then
C>   	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(2X,A5)
C>	read (111,160,err=3,end=440) title      ! one extra line
C>	read (111,170,err=3,end=440) (datm(jdy,k),k=0,11)
	x5f2=txtjp(112:116)
	x5h2=txtjp(152:156)
	x5M2=txtjp(202:206)
	do i=1,5
	if (x5f2(i:i).eq.' ') x5f2(i:i)='0'
	if (x5h2(i:i).eq.' ') x5h2(i:i)='0'
	if (x5m2(i:i).eq.' ') x5m2(i:i)='0'
	enddo
	read(x5f2,*) yf2
	read(x5h2,*) yh2
	read(x5m2,*) ym2
	im3=0
	if (yf2.gt.0.) im3=nint(ym2/yf2*100.)
	if2=nint(yf2/10.)
	ih2=nint(yh2/10.)
	call blet3(if2,afof2)
	call blet3(ih2,ahmf2)
	call blet3(im3,am3f2)
	XXXXX='     '
      XXXXX(1:3)=afof2
	if (XXXXX(1:1).eq.'0') XXXXX(1:1)=' '
	datf(jdy,jst)=XXXXX
	XXXXX(1:3)=ahmf2
	dath(jdy,jst)=XXXXX
	XXXXX(1:3)=am3f2
	datm(jdy,jst)=XXXXX
c	write(*,171) dath(jdy,k)
c	write(*,171) datf(jdy,k)
c	write(*,171) datm(jdy,k)	!++

c-	pause ' '
C??	endif
  177	CONTINUE       ! cycle on UT

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

C
crem	do j=1,jdy				! Start of output
	do j=idy1,idy2				! Start of output
	if (st.eq.'sw') then
	datf(j-1,21)=datf(j,0)	! Shift from LT to UT   foF2
	datf(j-1,22)=datf(j,1)	! Shift from LT to UT   foF2
	datf(j-1,23)=datf(j,2)	! Shift from LT to UT   foF2
c
	dath(j-1,21)=dath(j,0)	! Shift from LT to UT   hmF2
	dath(j-1,22)=dath(j,1)	! Shift from LT to UT   hmF2
	dath(j-1,23)=dath(j,2)	! Shift from LT to UT   hmF2
c
	datm(j-1,21)=datm(j,0)	! Shift from LT to UT   
	datm(j-1,22)=datm(j,1)	! Shift from LT to UT   
	datm(j-1,23)=datm(j,2)	! Shift from LT to UT   M3000
c
	do i=0,20
	datf(j,i)=datf(j,i+3)		! Shift from LT to UT foF2
	dath(j,i)=dath(j,i+3)		! Shift from LT to UT hpF2
	datm(j,i)=datm(j,i+3)		! Shift from LT to UT MUF
	enddo
	                  else
	datf(j-1,15)=datf(j,0)	! Shift from LT to UT   foF2
	datf(j-1,16)=datf(j,1)	! Shift from LT to UT   foF2
	datf(j-1,17)=datf(j,2)	! Shift from LT to UT   foF2
	datf(j-1,18)=datf(j,3)	! Shift from LT to UT   foF2
	datf(j-1,19)=datf(j,4)	! Shift from LT to UT   foF2
	datf(j-1,20)=datf(j,5)	! Shift from LT to UT   foF2
	datf(j-1,21)=datf(j,6)	! Shift from LT to UT   foF2
	datf(j-1,22)=datf(j,7)	! Shift from LT to UT   foF2
	datf(j-1,23)=datf(j,8)	! Shift from LT to UT   foF2
C
	dath(j-1,15)=dath(j,0)	! Shift from LT to UT   hmF2
	dath(j-1,16)=dath(j,1)	! Shift from LT to UT   hmF2
	dath(j-1,17)=dath(j,2)	! Shift from LT to UT   hmF2
	dath(j-1,18)=dath(j,3)	! Shift from LT to UT   hmF2
	dath(j-1,19)=dath(j,4)	! Shift from LT to UT   hmF2
	dath(j-1,20)=dath(j,5)	! Shift from LT to UT   hmF2
	dath(j-1,21)=dath(j,6)	! Shift from LT to UT   hmF2
	dath(j-1,22)=dath(j,7)	! Shift from LT to UT   hmF2
	dath(j-1,23)=dath(j,8)	! Shift from LT to UT   hmF2
C
	datm(j-1,15)=datm(j,0)	! Shift from LT to UT   
	datm(j-1,16)=datm(j,1)	! Shift from LT to UT   
	datm(j-1,17)=datm(j,2)	! Shift from LT to UT   
	datm(j-1,18)=datm(j,3)	! Shift from LT to UT   
	datm(j-1,19)=datm(j,4)	! Shift from LT to UT   
	datm(j-1,20)=datm(j,5)	! Shift from LT to UT   
	datm(j-1,21)=datm(j,6)	! Shift from LT to UT   
	datm(j-1,22)=datm(j,7)	! Shift from LT to UT   
	datm(j-1,23)=datm(j,8)	! Shift from LT to UT   M3000
	do i=0,14
	datf(j,i)=datf(j,i+9)		! Shift from LT to UT foF2
	dath(j,i)=dath(j,i+9)		! Shift from LT to UT hpF2
	datm(j,i)=datm(j,i+9)		! Shift from LT to UT MUF
	enddo
	              endif
	enddo
	if (st.eq.'sw') then
	do k=21,23
		 datf(idy2,k)='     '
	datm(idy2,k)='     '
		 dath(idy2,k)='     '
	enddo
                 else
	do k=15,23
		 datf(idy2,k)='     '
	datm(idy2,k)='     '
		 dath(idy2,k)='     '
	enddo
	endif
C
  173	format(3A2)
  174	format(3A2,2X,24(A5))
C output
	idmin=idy1-1
	if (idy1.eq.1) idmin=idy1
C=
C	do jdy=idmin,idy2
	call blet2(idmin,ddd)
	XXXXX=' 00  '
	DO nj=1,100
	read(12,173,end=275) BYR,BMN,BDY
	read(13,173,end=275) BYR,BMN,BDY
	read(14,173,end=275) BYR,BMN,BDY 
	if ((BYR.eq.YR).and.(BMN.eq.AMN).and.(BDY.eq.DDD)) then
	backspace(12)
	backspace(13)
	backspace(14)
      read(12,174) BYR,BMN,BDY,(XXXF2(k),k=0,23)
	read(13,174) BYR,BMN,BDY,(XXXM3(k),k=0,23) 
	read(14,174) BYR,BMN,BDY,(XXXH2(k),k=0,23) 
	exit
	endif
	enddo
C	
275	close(unit=12)
      close(unit=13)
      close(unit=14)	
  			OPEN(12,FILE=OUTFILEF,ACCESS='APPEND')	 !foF2
 	OPEN(13,FILE=OUTFILEM,ACCESS='APPEND')			  !M3000
	OPEN(14,FILE=OUTFILEH,ACCESS='APPEND')			  !hmF2

	do k=0,23
	if (datf(idmin,k).eq.'     ') datf(idmin,k)=XXXF2(k)
	if (datm(idmin,k).eq.'     ') datm(idmin,k)=XXXM3(k)
	if (dath(idmin,k).eq.'     ') dath(idmin,k)=XXXH2(k)
	enddo
	idmin=idy1-1
	do jdy=idmin,idy2
	call blet2(jdy,ddd)
	if (jdy.eq.1) then
	write(*,175) st,yr,amn
	write(12,175) st,yr,amn
	write(13,175) st,yr,amn
	write(14,175) st,yr,amn
	endif
	write(*,172) yr,amn,ddd,(datf(jdy,k),k=0,23)
c	write(*,172) yr,amn,ddd,(datm(jdy,k),k=0,23)
c	write(*,172) yr,amn,ddd,(dath(jdy,k),k=0,23)
c	write(12,172) yr,amn,ddd,(datf(jdy,k),k=0,23)
c	write(13,172) yr,amn,ddd,(datm(jdy,k),k=0,23)
c	write(14,172) yr,amn,ddd,(dath(jdy,k),k=0,23)
Ctemp	write(*,176) (datf(jdy,k),k=0,23)
	write(*,176) (datm(jdy,k),k=0,23)
	write(*,176) (dath(jdy,k),k=0,23)
	write(12,176) (datf(jdy,k),k=0,23)
	write(13,176) (datm(jdy,k),k=0,23)
	write(14,176) (dath(jdy,k),k=0,23)
	enddo
	close(unit=12)
	close(unit=13)
	close(unit=14)
C
  700	lda=lda+idy2
	if (lda.lt.ndnr) GOTO 701
      CLOSE (unit=111)
C??  		goto 111  ! NEXT station
  172	format(3A2,2X,24(A5))
  175	format(1X,A2,10X,'20',A2,1X,A2)
  176	format(24(A5))
	GOTO 2
    3	 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
   2   continue
	pause ' '
      STOP
	END
C -----------------------------------------------------------
