	program extRALiwg
C......................................................Nov. 2017
C
c EXTRACT foF2 <dat(1)> FROM RAL DAILY-HOURLY FILE , 
C
C Port-Stanley <ps>
	DIMENSION im(12)
	CHARACTER*128 infile,outfile,outfile1
      	CHARACTER*60 TXT
 	CHARACTER*4 AYEAR,CYEAR,START,COMP,CHAR
	CHARACTER*13 STAT
		CHARACTER*1 fmh
	CHARACTER*2 AYR,AMN,ADY,ST
	+,CMN,CDY
C     +,BMN,BDY,BUT,BMIN
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ,CODE
	CHARACTER*5 DATF(0:32,0:23),XFOF2,CC,BLANK(0:23)
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
CREM       write(*,*) 'Enter ST '
CREM	read(*,22) ST
      	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
	CC='    C'
	do i=0,23
	blank(i)=CC
	enddo
      TT(5:)='      '
	CYEAR=DD(1:4)
	CMN=DD(5:6)
	CDY=DD(7:8)
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
	START='Time'
C
C	fmh='f'         ! TEMP+++++++++++++++++++++++++++++
	fmh='m'         ! TEMP+++++++++++++++++++++++++++++
	if (fmh.eq.'f') then
	CHAR='foF2'
	else
	CHAR='M3F2'
	endif
C
	st='ps'
	stat='PORT STANLEY '
	CODE='PSJ5J'
	glat=-51.7
	glon=302.2
C++	infile='d:\web\graf\YEAR\psYEARfRAL.txt'
C	st='bp'
C	stat='Bejing.'
C	st='dy'
C	stat='Dyess AFB.'
cMillstone Hill
c	st='eg'
c	stat='Eglin AFB.'
c	st='mh'
c	stat='Millstone Hill.'
c	st='mw'
c	stat='Mawson.'
c	st='pa'
c	stat='Pt Arguello.'
c	st='rm'
c	stat='Ramey.'
c	st='br'
c	stat='Brisbane.'
c	st='cb'
c	stat='Canberra.'
c	st='cr'
c	stat='Christchurch.'
c	st='dw'
c	stat='Darwin.'
c	st='ho'
c	stat='Hobart.'
c	st='mq'
c	stat='Macquarie Is.'
c	st='mu'
c	stat='Mundaring.'
c	st='py'
c	stat='Port Moresby.'
c	st='sq'
c	stat='Scott Base.'
c	st='tv'
c	stat='Townsville.'
c	st='va'
c	stat='Vanimo.'
c	st='os'
c	stat='Osan.'
c      st='sj'
c	stat='San Juan.'
c      st='tr'
c	stat='Tromso.'
c      st='le'
c	stat='Lerwick.'
c      st='ch'
c	stat='Chilton.'
	

	infile='d:\web\graf\YEAR\stYEARfral.txt'
	infile(24:24)=fmh
C
C   START:
C
   1      write(*,*) 'Enter YEAR'
	read(*,*) AYEAR
CREM	AYEAR='2017'
        infile(13:16)=AYEAR
	infile(18:19)=st
	infile(20:23)=AYEAR
   19 format(A4)
	OPEN(33,FILE=INFILE,action='READ')
    5	read(33,19) COMP
      if (COMP.eq.START) then
C	read(33,19) txt
       backspace(33)
	goto 6
	                   else
	goto 5
	endif
C
    6	AYR=AYEAR(3:4)
	read(ayr,*) ryr
	jyr=int(ryr)
C
	if(int(ryr/4.)*4.eq.jyr) THEN 
 	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF
C
       outfile='d:\web\dat1\YR\stYRMN.txt'
	outfile(13:14)=AYR
	outfile(16:17)=st
	outfile(18:19)=AYR
	outfile1='d:\web\graf\YEAR\stYEARf'
	outfile1(13:16)=AYEAR
	outfile1(18:19)=st
	outfile1(20:23)=AYEAR
	outfile1(24:24)=fmh
	OPEN(34,FILE=OUTFILE1)
C	jmn1=1
	jmn1=1
C Monthly cycle
Crem        DO 140 jmn=jmn1,12
	jmn=jmn1-1
1140	 jmn=jmn+1
      if (jmn.gt.12) goto 44
C-	if ((jyr.eq.95).and.((jmn.gt.4).and.(jmn.lt.10))) goto 140 ! REM
       call blet2(jmn,AMN)
	outfile(20:21)=AMN
	OPEN(14,FILE=OUTFILE)
	write(*,16) stat,CODE,glat,glon,AYEAR,AMN,CHAR
	write(34,16) stat,CODE,glat,glon,AYEAR,AMN,CHAR
   16	format(A13,3X,A5,4X,2F5.1,29X,A4,2X,A2,2X,A4)
	write(14,17) stat
   17	format(A13)
		WRITE(*,18) cyear,cmn,cdy,TT
	WRITE(14,18) cyear,cmn,cdy,TT
  18	format('Date of issue: ',A4,'/',A2,'/',A2,' Time:',A4)
		write(14,201)
dd 	write(*,201) 
  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'/'-------------------------------------------'
     &'-------------------------------------------------------------'
     &'------------------------')
C
	ndmn=im(jmn)
C
	if (jmn.gt.1) then
	ndmn_pre=im(jmn-1)
	do i=0,3
	DATF(0,i)=DATF(ndmn_pre+1,i)
	enddo
	endif
C
       do k=1,32
	DO i=0,23
	DATF(k,i)=' 00  '
	ENDDO
	 enddo
C
        jdy=0
C Daily cycle
C        DO 141 jdy=jdy1,ndmn
 1141	continue
      jdy=jdy+1
	if (jdy.gt.ndmn) goto 141
	call blet2(jdy,ADY)
C
	do k=0,23
      datf(jdy,k)=CC
	enddo
C
C Calculate day-of-year:
C	lday=ndoy(jyr,jmn,jdy) ! function to define day-of-year
C	write(*,17) doy
C
c
  333 FORMAT(a60)
  331	FORMAT(I4,I2)

C Read data file:
C
  190	FORMAT(24A5)
C  UT cycle
C&	DO 142 jut=0,23
   55		read(33,19,end=44) COMP
      if (COMP.ne.START) then ! 1
	backspace(33)
	GOTO 155		 
	endif            ! 1
	 	read(33,19) txt ! "YEAR..."	  COMP=Time
	if (kdy1.eq.ndmn) then
	write(*,180) ayr,amn,ady,(datf(jdy,k),k=0,23)  ! last day-of-month
	write(14,180) ayr,amn,ady,(datf(jdy,k),k=0,23)
	write(34,190) (datf(jdy,k),k=0,23)
	do jk=ndmn+1,33
	write(34,190) (blank(k),k=0,23)
	enddo
C	close(unit=14)
      endif
	read(33,331) kyear,kmn
		backspace(33)
	if (kmn.gt.jmn) then			 ! 2
	jmn=kmn-1
	if (jdy.lt.ndmn) then			 ! 3
	DO k=jdy,ndmn
	write(*,180) ayr,amn,ady,(datf(jdy,k),k=0,23)  ! missed days
	write(14,180) ayr,amn,ady,(datf(jdy,k),k=0,23)
      enddo
	endif							 !3
	close(unit=14)
	goto 1140
	          else
	goto 155
	endif							 !2
  332	FORMAT(I4,I2,I2,1X,I2,I2,3X,A5)

C  155  READ(33, 333, END=44) txt
  155 READ(33, 332, END=44) kyear,kmn,kdy,kut,kmin,XFOF2
	if (KMIN.ne.0) goto 55
C
        if (kdy.gt.jdy) then
	write(*,180) ayr,amn,ady,(datf(jdy,k),k=0,23)  ! missed day
	write(14,180) ayr,amn,ady,(datf(jdy,k),k=0,23)
	write(34,190) (datf(jdy,k),k=0,23)
	backspace(33)
	goto 1141
	else
	GOTO 1155
        endif
 1155	kdy1=kdy
C	kut=int(rut)
	kut1=kut
C Add at UT-4h >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> CHECK UT-4h>>>>>>>>>>>>>>
C++	 kut1=kut+4
C++	if (kut1.gt.23) then
C++	kut1=kut1-24
C++	kdy1=kdy+1
C++	endif
	DATF(kdy1,kut1)=XFOF2
C	if ((kdy1.eq.ndmn).and.(kut1.eq.23)) then
C	write(*,180) ayr,amn,ady,(datf(jdy,k),k=0,23)  ! last day-of-month
C	write(14,180) ayr,amn,ady,(datf(jdy,k),k=0,23)
C	close(unit=14)
C      endif
	GOTO 55

 141	CONTINUE
  180	format(3A2,2X,24(A5))
 140	goto 1140
   44		write(*,180) ayr,amn,ady,(datf(jdy,k),k=0,23)
 	write(14,180) ayr,amn,ady,(datf(jdy,k),k=0,23)
	write(34,190) (datf(jdy,k),k=0,23)
	write(34,190) (blank(k),k=0,23)
	write(34,190) (blank(k),k=0,23)
       close(unit=33)
       close(unit=14)
       close(unit=34)
C
rem	pause ' '
	goto 2
    3	 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
    2  	write(*,*) infile
	pause ' '
C	goto 1
C
      STOP
	END
C ===============================================================

c=====================================================================================