      program polyfht80
C.......................................................July 2019
C Apply Polyfit2 coefficients for 0,1,...,23 UT of two parameters for 80 stations
C
      dimension IM(12)
	+,pf1(80),pf2(80),pf3(80),ph1(80),ph2(80),ph3(80)
	 INTEGER idatf(0:23),idath(0:23),idatt(0:23)
	character*128 infilef,infileh,infilet,infpolyf,infpolyh
	+,outfilef,outfileh,txt       ! July 2019
      CHARACTER*2 ST,STS(80),AYR,AMN,ADY,STCOEF(80)
	+,CC,CF(0:23),CH(0:23),CYR,CMN,CDY			   ! July 2019
	 CHARACTER*1 C
C	common /BL1/xi,yi
      DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
      DATA STS/
     + 'as','at','bc','bp','br','cb','ch','cn','cq','cs'     ! July 2019
     +,'cw','cr','db','dw','eg','eb','gm','gr','gu','ha'	   ! July 2019
     +,'he','ho','jj','jm','jr','kk','lm','ml','mo','mq'	   ! July 2019
     +,'mw','nd','ni','ok','pe','pq','ps','rm','ro','vt'	   ! July 2019
     +,'sq','tv','tr','wk','wp','wz','mm','tk','kg','mg'	   ! July 2019
     +,'sd','rv','tz','ns','so','mb','ei','gg','if','tu'     ! July 2019
     +,'pa','fz','ff','kh','au','al','ga','nc','yg','ic'	   ! July 2019
     +,'mh','bb','bl','sv','lv','sj','sp','cj','er','ll'/	   ! July 2019
C
C
      infilef='d:\web\dat1\YR\stYRMN.txt'                            ! July 2019
	infileh='d:\web\dat6\YR\stYRMNh.txt'                           ! July 2019
	infilet='d:\web\dat7\YR\stYRMNt.txt'                           ! July 2019
      WRITE(*,*) ' ENTER JYR and JMN FOR INPUT FILE='  ! July 2019
      READ(*,*) JYR,JMN                                ! July 2019
C    
	call blet2(jyr,AYR)
	call blet2(jmn,AMN)
	ryr=float(jyr)
	if(int(ryr/4.)*4.eq.jyr) THEN 
		im(2)=29
	                          ELSE
		IM(2)=28
	ENDIF
	ndmn=im(jmn)
C
C Input Poly coefficients
C
      infpolyf='polYRMNf.txt'
	infpolyh='polYRMNh.txt'
	infpolyf(4:5)=AYR
	infpolyh(4:5)=AYR
	infpolyf(6:7)=AMN
	infpolyh(6:7)=AMN
	OPEN(10,file=infpolyf,action='READ')
	OPEN(11,file=infpolyh,action='READ')
	DO k=1,80
	read(10,*,end=41) STCOEF(k),pf1(k),pf2(k),pf3(k) 
	read(11,*,end=42) STCOEF(k),ph1(k),ph2(k),ph3(k) 
	enddo
   41	close(unit=10)
   42	close(unit=11)
C
C Input data
C
	infilef(13:14)=AYR
	infilef(18:19)=AYR
	infilef(20:21)=AMN
	infileh(13:14)=AYR
	infileh(18:19)=AYR
	infileh(20:21)=AMN
	infilet(13:14)=AYR
	infilet(18:19)=AYR
	infilet(20:21)=AMN
	outfilef=infilef
	outfileh=infileh
	outfilef(23:25)='dat'
	outfileh(24:26)='dat'

   1  DO 1234 ist=1,80
C
       st=sts(ist)                                  ! July 2019
	if (st.ne.STCOEF(ist)) THEN
	write (*,*) ' Check stations ST names:',st,stcoef(ist)
	pause ' '
	goto 1234
	endif
	infilef(16:17)=st								  ! July 2019
	infileh(16:17)=st								  ! July 2019
	infilet(16:17)=st								  ! July 2019
	outfilef(16:17)=st
	outfileh(16:17)=st
C
	OPEN(10,file=infilef,action='READ')
	OPEN(11,file=infileh,action='READ')
	OPEN(12,file=infilet,action='READ')
	OPEN(13,file=outfilef)
	OPEN(14,file=outfileh)
C
       DO k=1,4
	read(10,29,end=43) txt ! title line
	write(13,29) txt
	read(11,29,end=44) txt ! title line
	write(14,29) txt
	read(12,29,end=45) txt ! title line
	 ENDDO
C
   29 FORMAT(A128)
   30 FORMAT(3A2,2X,24(I3,A2))
   31 FORMAT(3A2,1X,24(I4,1X))
C
C Day-to-day cycle
C
	DO 10 jdy=1,ndmn
	call blet2(jdy,ADY)
	read(10,30,end=43) CYR,CMN,CDY,(idatf(k),CF(k),k=0,23)
	read(11,30,end=44) CYR,CMN,CDY,(idath(k),CH(k),k=0,23)
	read(12,31,end=45) CYR,CMN,CDY,(idatt(k),k=0,23)
C
      DO iut=0,23
	tec=idatt(iut)/10.0
C check foF2
	CC=CF(iut)
	C=CC(1:1)
	IF ((C.eq.'/').or.(C.eq.'_')) THEN
	 rnm=tec*(pf1(ist)*tec+pf2(ist))+pf3(ist)
	if (rnm.lt.4.0) rnm=4.0
	fof2=sqrt(rnm/1.24)
	CC(1:1)='_'
	CF(iut)=CC
	idatf(iut)=nint(fof2*10.)
	                           ENDIF
C check hmF2
	CC=CH(iut)
	C=CC(1:1)
	IF ((C.eq.'/').or.(C.eq.'_')) THEN
	 hmF2=tec*(ph1(ist)*tec+ph2(ist))+ph3(ist)
	CC(1:1)='_'
	CH(iut)=CC
	idath(iut)=nint(hmf2)
	                              ENDIF
	ENDDO
	write(*,30) CYR,CMN,CDY,(idatf(k),CF(k),k=0,23)
	write(13,30) CYR,CMN,CDY,(idatf(k),CF(k),k=0,23)
	write(*,30) CYR,CMN,CDY,(idath(k),CH(k),k=0,23)
	write(14,30) CYR,CMN,CDY,(idath(k),CH(k),k=0,23)
   10	CONTINUE			 ! next day
   43 close(unit=10)
   44 close(unit=11)
   45 close(unit=12)
   	close(unit=13)
 	close(unit=14)
C
 1234 CONTINUE     ! next st
C
C
	pause ' '
	END
C=========================================
