C .......................................................Jan 2015
C Extract fcF2, hcF2, TEC for => .inp to IRI-Plas at given site
C
C 
C Output: .inp file styrmndy.inp
C
      PROGRAM EXTRAHFT1
C---------------------------------------------------------------
C data for 24 UT=0,1,2,...23hUT daily
C
C
C*********TEST
	CHARACTER*90 OUTFILE,infilef,infileh,infilem,infilet,txt
	CHARACTER*41 txt1,txt2
	character*2 ayr,amn,ST
	+,ADY,AUT
	INTEGER*2 IDY,iut,iut25
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*1 fht,CC
	CHARACTER*4 STAT
	CHARACTER*4 XXXX,DATF(0:23),DATH(0:23),DATM(0:23),DATT(0:23)
	dimension im(12),IRESF(0:23),IRESH(0:23),IRESM(0:23),IREST(0:23)
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
	data txt1/'140915  000 25.0   0  -1 -1 0  39.9  32.8'/
	data txt2/'   0.0   0.0   0.0     0  0.0     00.00  '/
C
c
	      CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
       CC='_'
C read stations coordinates
  76	format(2(1X,F5.1),1X,A4,1X,A2)
c   77	format(30X,A5,1X,A5,40X,A4,9X,A2)
c	ST='an' ! Ankara
c	STAT='ankr'
c	glat=39.9
c	glon=32.8
c	ST='is' ! Istanbul
c	STAT='ista'
c	glat=41.1
c      glon=29.0
c		ST='hn' ! Honolulu
c	 STAT='hnlc'
c	glat=21.3
c	glon=201.9
c		ST='am' ! Amderma
c	 STAT='amdm'
c	glat=69.6
c	glon=60.2
c		ST='go' ! Gorkovskaya
c	 STAT='gork'
c	glat=60.3
c	glon=29.4
c		ST='lo' ! Lovozero
c	 STAT='lovo'
c	glat=68.0
c	glon=35.0
c		ST='ne' ! Nepal
c	 STAT='nepl'
c	glat=28.2
c	glon=84.7
c	ST='pb' ! Pevek
c	STAT='pevk'
c	glat=70.8
c	glon=170.9
c	ST='di' ! Dikson
c	STAT='diks'
c	glat=73.5
c	glon=80.4
c	ST='tk' ! Tomsk
c	STAT='toms'
c	glat=56.5
c	glon=84.9
c	ST='wz' ! Warsaw
c	STAT='wars'
c	glat=52.2
c	glon=21.1
c	ST='mo' ! Moscow
c	STAT='mosk'
c	glat=55.5
c     glon=37.3
c		ST='gg' ! Guam
c	 STAT='guam'
c	glat=13.6
c	glon=144.9
c		ST='ad' ! Ashkhabad
c	 STAT='ashk'
c	glat=37.9
c	glon=58.3
c		ST='ff' ! Fairford
c	 STAT='fair'
c	glat=51.7
c	glon=358.2
c		ST='mh' ! Millston Hill
c	 STAT='wes2'
c	glat=42.6
c	glon=288.5
c		ST='bp' ! Beijing  39.6 115.9
c	 STAT='bjfs'
c	glat=39.6
c	glon=115.9
c		ST='ch' ! Chilton
c	 STAT='hers'
c	glat=50.9
c	glon=0.3
c	ST='dw' ! Darwin -12.8 131.1
c	STAT='darw'
c	glat=-12.8
c	glon=131.1
c		ST='eb' ! Ebre
c	 STAT='ebre'
c	glat=40.8
c	glon=0.5
c		ST='ei' ! Eielson
c	 STAT='eil1'
c	glat=64.7
c	glon=212.9
c		ST='he' ! Hermanus
c	 STAT='hnus'
c	glat=-34.4
c	glon=19.2
c		ST='ho' ! Hobart
c	 STAT='hob2'
c	glat=-42.8
c	glon=147.4
c		ST='jm' ! Jicamarca
c	 STAT='areq'
c	glat=-16.5
c	glon=288.5
c		ST='jr' ! Juliusruh
c	 STAT='warn'
c	glat=54.2
c	glon=12.1
c		ST='kk' ! Kokubunji
c	 STAT='kgni'
c	glat=35.7
c	glon=139.5
c		ST='mw' ! Mawson
c	 STAT='maw1'
c	glat=-67.6
c	glon=62.9
c		ST='pa' ! Point Arguello
c	 STAT='harv'
c	glat=34.5
c	glon=239.3
c		ST='ps' ! Port Stanley
c	 STAT='falk'
c	glat=-51.7
c	glon=302.1
c		ST='rm' ! Ramey
c	 STAT='cro1'
c	glat=17.8
c	glon=295.4
c			ST='so' ! Sodankyla
c 	 STAT='mets'
c	glat=60.2
c	glon=24.4
c			ST='tr' ! Tromso
c 	 STAT='tro1'
c	glat=69.7
c	glon=18.9
c		ST='ns' ! Novosibirsk
c 	 STAT='nvsk'
c	glat=55.0
c	glon=82.9
c		ST='hn' ! Honolulu
c 	 STAT='hnlc'
c	glat=21.3
c	glon=202.1
c		ST='as' ! Ascension
c	 STAT='asc1'
c	glat=-7.9
c	glon=345.7
c		ST='ga' ! Gakona
c 	STAT='gako'
c	glat=62.4
c	glon=215.0
c		ST='al' ! Alpena
c 	STAT='alpe'
c	glat=45.1
c	glon=276.4
c		ST='tm' ! Test mid-lat
c 	STAT='test'
c	glat=40.0
c     glon=30.0
c		ST='te' ! Test equator
c 	STAT='test'
c	glat=0.0
c	glon=30.0
c		ST='mo' ! Moscow
c 	STAT='mosc'
c	glat=55.5
c	glon=37.3
c		ST='bb' ! Bahia Blanca
c 	STAT='bahb'
c	glat=-38.7
c	glon=297.7
c		ST='bl' ! Belem
c 	STAT='bele'
c	glat=-1.43
c	glon=311.6
c		ST='sp' ! Sopron
c 	STAT='sopr'
c	glat=47.7
c	glon=16.6
c		ST='er' ! Eareckson
c 	STAT='eare'
c	glat=52.7
c	glon=185.9
c		ST='ll' ! Lualualei
c 	STAT='lual'
c	glat=21.4
c	glon=201.85
c		ST='tr' ! Tromso
c 	STAT='tro1'
c	glat=69.7
c	glon=18.9
c		ST='cj' ! Cachoeira
c 	STAT='cach'
c	glat=-22.7
c	glon=315.0
c		ST='sj' ! San Juan
c 	STAT='sahu'
c	glat=18.5
c	glon=294.0
c		ST='fz'! Fortaleza
c 	STAT='fort'
c	glat=-3.9
c	glon=321.6
c		ST='tu'! Tucuman
c 	STAT='tucu'
c	glat=-26.9
c	glon=294.6
c		ST='ki'! Kiruna
c 	STAT='kiru'
c	glat=67.9
c	glon=21.0
c		ST='mb' ! Obninsk
c 	STAT='mobn'
c	glat=55.1
c	glon=36.6
c		ST='nc'! Nicosia
c 	STAT='nico'
c	glat=35.0
c	glon=33.2
c		ST='ad'! Addis Abeba
c 	STAT='adis'
c	glat=9.0
c	glon=38.8
c		ST='za'! Lusaka, Zambia
c 	STAT='zamb'
c	glat=-15.4
c	glon=28.3
c		ST='su'! Sutherland, South Africa
c 	STAT='sutm'
c	glat=-32.4
c	glon=20.8
c		ST='cz'! Alfred-Faure
c 	STAT='cztg'
c	glat=-46.4
c	glon=51.9
c		ST='sy'! East Ongle Is, Antarctica
c 	STAT='syog'
c	glat=-69.0
c	glon=39.6
c		ST='sa' ! Sao Luis
c	 STAT='saol'
c	glat=-2.6
c	glon=315.8
c		ST='cb' ! Canberra
c	 STAT='canb'
c	glat=-35.3
c	glon=149.1
c		ST='ea' ! El Arenosillo
c	 STAT='elar'
c	glat=37.1
c	glon=353.3
		ST='yk' ! El Arenosillo
	 STAT='yakt'
	glat=62.0
	glon=129.6
	write(*,76) glat,glon,stat,st

C
  201	      WRITE(*,*)' ENTER yr,mn :'
		READ(*,15) AYR,AMN
   15	FORMAT(A2)
C       WRITE(*,*)' ENTER ADY:'
C		READ(*,15) ADY
C	if (ADY.eq.'00') goto 33       !stop
	read(ayr,*) yr
	iyr=int(yr)
	if(int(yr/4.)*4.eq.iyr) THEN 
	im(2)=29
	ndnr=366
	                          ELSE
	IM(2)=28
	ndnr=365
	ENDIF
	read(amn,*) xmn
	mn=int(xmn)

c		read(ady,*) xdy
c 	idy=int(xdy)
C day-to-day cycle
	idy=0
	ndnr=im(mn)
  202	continue
   	idy=idy+1
	if (idy.gt.ndnr) goto 81
C
	call blet2(idy,ADY)
C start foF2, hmF2 or TEC

  199	nds=idy
C    
	txt(1:41)=txt1
	txt(42:82)=txt2
	txt(1:2)=AYR
	txt(3:4)=AMN
	if (idy.gt.0) txt(5:6)=ADY

	infilef='d:\web\graf\2014\styrf.txt'
	if ((AYR.eq.'98').or.(AYR.eq.'99')) infilef(13:14)='19'
	infilef(15:16)=AYR
	infilef(20:21)=AYR
	infileh=infilef
	infileh(22:22)='h'
	infilem=infilef
	infilem(22:22)='m'
	infilet=infilef
	infilet(22:22)='t'


   61	format(3A2,1X,24(A4,1X))
C
c-	DO 88 jj=1,31
c-	st=sts(jj)
c-	stat=stats(jj)
	write(*,79) stat
	txt(42:82)=txt2
	txt(83:85)=stat
	txt(87:88)=st
	iflag=1  ! TEC input

	infilef(18:19)=st
	infileh(18:19)=st
	infilem(18:19)=st
	infilet(18:19)=st
	do i=0,23
	datf(i)='    0'
	dath(i)='    0'
	datm(i)='    0'
	datt(i)='    0'
	iresf(i)=0
	iresh(i)=0
	iresm(i)=0
	irest(i)=0
	enddo

	DO iut=0,23
	call blet2(iut,AUT)
c-	fht='m'		! median TEC
c-	call subinterp1(fht,glat,glon,ayr,amn,ady,aut,res)
c-	iresm(iut)=nint(res)
	fht='f'		! foF2
	call subinterp1(fht,glat,glon,ayr,amn,ady,aut,res)
	iresf(iut)=nint(res)
	fht='h'		! hmF2
	call subinterp1(fht,glat,glon,ayr,amn,ady,aut,res)
	iresh(iut)=nint(res)
		fht='t'		! TEC
 	call subinterp1(fht,glat,glon,ayr,amn,ady,aut,res)
	irest(iut)=nint(res)
	ENDDO
C 200	format(3A2,24(1X,I4))
 200	format(3A2,1X,24(I4,A1))
	    OPEN(11,FILE=INFILEF,access='APPEND')  ! outfile
	    OPEN(12,FILE=INFILEH,access='APPEND')
	    OPEN(13,FILE=INFILEM,access='APPEND')  ! median TEC
1110    OPEN(14,FILE=INFILET,access='APPEND')
	write(*,200) ayr,amn,ady,(iresf(k),CC,k=0,23)
	write(11,200) ayr,amn,ady,(iresf(k),CC,k=0,23)
	write(*,200) ayr,amn,ady,(iresh(k),CC,k=0,23)
	write(12,200) ayr,amn,ady,(iresh(k),CC,k=0,23)
	write(*,200) ayr,amn,ady,(iresm(k),CC,k=0,23)
	write(13,200) ayr,amn,ady,(iresm(k),CC,k=0,23)
	write(*,200) ayr,amn,ady,(irest(k),CC,k=0,23)
	write(14,200) ayr,amn,ady,(irest(k),CC,k=0,23)
	GOTO 202
C
	outfile='styrmndy.inp'	! Create .inp file for IRI-Plas
	outfile(3:4)=ayr
	outfile(5:6)=amn
	outfile(7:8)=ady

C

C start cycle on stations
   79 format(1X,A4)

c	if (jj.lt.65) goto 88   ! last station only
	outfile(1:2)=st
	
      OPEN(110,FILE=outfile)

c	glat=glats(jj)
c	glon=glons(jj)
	txt(31:35)=glat
	txt(37:41)=glon
c
c	
C
c ***************************************************************
C
  107	FORMAT(3A2,2X,24(A3,2X))
  108	FORMAT(3A2,2X,24(A3,A2))
  109	FORMAT(A90)
C
C              /130313  000 25.0   0  -1 -1 0  51.6 358.7/
C              /   0.0   0.0   0.0  1HHH FF.F    TEC.XX  /
C start cycle on UT
	do iut=0,23
      iut25=iut+25
	call blet2(iut25,AUT)
	txt(13:14)=AUT
	XXXX=dath(iut)
	if ((XXXX.eq.'   0').or.(XXXX(4:4).eq.' ')) goto 41 ! No hmF2 for UT
C input hmF2
	txt(63:65)=XXXX(2:4)
	goto 42  ! avoid input of M3000

C input of M3000
   41	XXXX=datm(iut) 
	if ((XXXX.eq.'   0').or.(XXXX(4:4).eq.' ')) goto 42 ! No M3000 for UT
	txt(62:62)='1'
	txt(63:65)=XXXX(2:4)

C input of foF2
   42	XXXX=datf(iut) 
	if ((XXXX.eq.'   0').or.(XXXX(4:4).eq.' ')) goto 43 ! No foF2 for UT
		txt(67:68)=XXXX(2:3)
		txt(70:70)=XXXX(4:4)
C Input of TEC
   43	XXXX=datt(iut) 
	if ((XXXX.eq.'   0').or.(XXXX(4:4).eq.' ')) goto 44 ! No foF2 for UT
		txt(75:77)=XXXX(1:3)
		txt(79:79)=XXXX(4:4)
C
C output 
   44	write(*,109) txt
      write(110,109) txt
	enddo                   ! end cycle on UT
   80	continue
C
   81	close(unit=110)
  88	continue              ! end cycle on stations
 111	format(A6,1X,24(I4,1X))
	GOTO 33
C
    2 CONTINUE
       write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
 	pause ' '
	goto 34

   33	continue
      write(*,*) outfile
      pause ' ' 
   34   STOP
       END

C***********************************************************
