C........................................................June.2019
C Extract fixed TEC, hoF2, foF2, Hc (+Tau) from JPLR 1h files (2.5 x 5 deg) geomag. coord.
C mlongs=0.:5:360.
C mlats -87.5:2.5:87.5
C input TEC; D:\web\dts\YR\MN\toMNDDUT.jYR> IONEX files
C input hcF2: D:\web\dhs\YR\MN\hoMNDDUT.jYR> IONEX files
C input Hc: D:\web\dtc\YR\MN\coMNDDUT.jYR> IONEX files
C ??       Vs : D:\web\drs\YR\MN\vlMNDDUTMM.jYR index file
C output <tvGLATGLONG.jYR>
C 
      PROGRAM decodjplr1
C----------------------------------------------------------------
C
      integer itec(0:72),ihc(0:72),ihm(0:72),ifc(0:72),IM(12)
	+,itec2(0:72),ihc2(0:72),ihm2(0:72),ifc2(0:72)
	+,ktec(0:23),khc(0:23),khm(0:23),kf2(0:23),ktau(0:23)
C
	CHARACTER*2 AYR,AMN,ADY,AUT,ST,CMN,CDY
	CHARACTER*4 CYEAR,TIME
      CHARACTER*128 INFILET,INFILEF,INFILEC,INFILEH
	+,OUTFILET,OUTFILEF,OUTFILEC,OUTFILEH,OUTFILES ! TEC,fcF2,c-o-m,hmF2,tau
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*56 txt3,txt4,txt6
	CHARACTER*16 txt2,txt5
	CHARACTER*13 stname
	CHARACTER*7 txt1
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C++
C
      ICALLS=0
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
	CYEAR=DD(1:4)
	CMN=DD(5:6)
	CDY=DD(7:8)
      TT(5:)='      '
	TIME=tt(1:4)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C+       WRITE(*,*) ' Enter glati: '	 !mlati
C+	read(*,*) glat

C+       gmlat=52.55 !HERS mag lat ~ geogr. 50.87
C+	gmlon=85.01  !HERS mag lon ~ geogr.  0.34 UT=LT!!!
C+       gmlat=39.7 !MATE mag lat ~ geogr. 50.87
C+	gmlon=97.46  !MATE mag lon ~ geogr.  0.34 UT=LT!!!
       gmlat=76.0 !NYAL mag lat ~ geogr. 50.87
	gmlon=127.4  !NYAL mag lon ~ geogr.  0.34 UT=LT!!!

C++       gmlat=-9.1 !ntus mag lat ~ geogr. 1.2
C++	gmlon=175.0  !ntusmag lon ~ geogr.  103.4 UT=LT-7h
C++	glat=1.2	 !ntus
C++	glon=103.4	 !ntus
C+	glat=50.87	 !HERS
C+	glon=0.34	 !HERS
C+	st='hs' ! Haisham = HERS
C+	stname='Hailsham HERS'
C+	glat=40.46	 !MATE
C+	glon=16.70	 !MATE
C+	st='mt' ! Matera = MATE
C+	stname='Matera MATE  '
	glat=78.93	 !Nyal
	glon=11.87	 !Nyal
	st='ny' ! Ny Alesund = NYAL
	stname='NyAlesundNYAL'
C++	st='nt' ! Naniyang NTUS
C++	stname='Naniyang NTUS'
C 
C
      txt2='Date of issue:  '
      txt3='YYMMDD|UT 0    1    2    3    4    5    6    7    8    9'
	txt4='   10   11   12   13   14   15   16   17   18   19   20 '
	txt5='  21   22   23  '  
      txt6='--------------------------------------------------------'

       WRITE(*,*) ' Enter YR: '
	read(*,*) AYR
    1   WRITE(*,*) ' Enter MN or <00> - STOP: '
	read(*,*) AMN
	if (AMN.eq.'00') STOP
c-       WRITE(*,*) ' Enter iDY1,iDY2: '
c-	read(*,*) idy1,idy2
C
C
   30 FORMAT(1X,2A2,2(1X,F6.1))
   31 FORMAT(73(1X,I4))
   32 FORMAT(1X,4A2,1X,F5.1,3(1X,I4))
C
c---	
	WRITE(*,30) AYR,AMN,glat,glon ! =mlat,mlon
c=	WRITE(10,30) AYR,AMN,glat,glon ! =mlat,mlon
	read(ayr,*) ryr
	iyr=int(ryr)
		read(amn,*) rmn
 	imn=int(rmn)

	z1=ryr/4.
	jz=int(z1)*4
	IF(jz.EQ.iyr) THEN
               IM(2)=29
					dnr=366.
        ELSE
                IM(2)=28
	  	dnr=365.
	       ENDIF
C
        outfilet='d:\web\dat7\YR\stYRMNt.txt'
	outfilef='d:\web\dat1\YR\stYRMN.txt'
	outfileh='d:\web\dat6\YR\stYRMNh.txt'
	outfiles='d:\web\dat9\YR\stYRMNs.txt'
	outfilec='d:\web\dat8\YR\stYRMNc.txt'
	outfilet(13:14)=AYR
	outfilet(16:17)=ST
	outfilet(18:19)=AYR
	outfilet(20:21)=AMN
C
	outfilef(13:14)=AYR
	outfilef(16:17)=ST
	outfilef(18:19)=AYR
	outfilef(20:21)=AMN
C
	outfileh(13:14)=AYR
	outfileh(16:17)=ST
	outfileh(18:19)=AYR
	outfileh(20:21)=AMN
C
	outfiles(13:14)=AYR
	outfiles(16:17)=ST
	outfiles(18:19)=AYR
	outfiles(20:21)=AMN
C
	outfilec(13:14)=AYR
	outfilec(16:17)=ST
	outfilec(18:19)=AYR
	outfilec(20:21)=AMN
C
	OPEN(15,file=outfilet)
	OPEN(16,file=outfilec)
	OPEN(17,file=outfileh)
	OPEN(18,file=outfilef)
	OPEN(19,file=outfiles)
  130	format(A13,1X,A7,2X,'glat =',1X,F5.1,1X,'glon =',1X,F5.1)    ! txt1=foF2
  136	format(A16,A4,2A2,1X,'Time = ',A4,1X)
  137	format(2A56,A16,1X)

C
	txt1='TEC*10 '
	write(*,130) stname,txt1,glat,glon
	write(15,130) stname,txt1,glat,glon
	write(*,136) txt2,CYEAR,CMN,CDY,TIME
	write(15,136) txt2,CYEAR,CMN,CDY,TIME
	write(*,137) txt3,txt4,txt5
	write(15,137) txt3,txt4,txt5
	write(*,137) txt6,txt6,txt6
	write(15,137) txt6,txt6,txt6
C
	txt1='Hc-o-m '
	write(*,130) stname,txt1,glat,glon
	write(16,130) stname,txt1,glat,glon
	write(*,136) txt2,CYEAR,CMN,CDY,TIME
	write(16,136) txt2,CYEAR,CMN,CDY,TIME
	write(*,137) txt3,txt4,txt5
	write(16,137) txt3,txt4,txt5
	write(*,137) txt6,txt6,txt6
	write(16,137) txt6,txt6,txt6
C
	txt1='hmF2   '
	write(*,130) stname,txt1,glat,glon
	write(17,130) stname,txt1,glat,glon
	write(*,136) txt2,CYEAR,CMN,CDY,TIME
	write(17,136) txt2,CYEAR,CMN,CDY,TIME
	write(*,137) txt3,txt4,txt5
	write(17,137) txt3,txt4,txt5
	write(*,137) txt6,txt6,txt6
	write(17,137) txt6,txt6,txt6
C
	txt1='foF2*10'
	write(*,130) stname,txt1,glat,glon
	write(18,130) stname,txt1,glat,glon
	write(*,136) txt2,CYEAR,CMN,CDY,TIME
	write(18,136) txt2,CYEAR,CMN,CDY,TIME
	write(*,137) txt3,txt4,txt5
	write(18,137) txt3,txt4,txt5
	write(*,137) txt6,txt6,txt6
	write(18,137) txt6,txt6,txt6
C
	txt1='tau    '
	write(*,130) stname,txt1,glat,glon
	write(19,130) stname,txt1,glat,glon
	write(*,136) txt2,CYEAR,CMN,CDY,TIME
	write(19,136) txt2,CYEAR,CMN,CDY,TIME
	write(*,137) txt3,txt4,txt5
	write(19,137) txt3,txt4,txt5
	write(*,137) txt6,txt6,txt6
	write(19,137) txt6,txt6,txt6

C	infilet='D:\UTEC\20YR\MN\tiMNDDUTMM.jYR'
CC	infilev='D:\web\drs\YR\MN\vlMNDDUTMM.jYR'
	infilet='d:\web\dts\YR\MN\toMNDDUT.jYR'
	infileh='d:\web\dhs\YR\MN\hoMNDDUT.jYR'
	infilec='d:\web\dhc\YR\MN\coMNDDUT.jYR'
	infilef='d:\web\dfs\YR\MN\foMNDDUT.jYR'
	infilet(12:13)=AYR
	infilet(15:16)=AMN
	infilet(20:21)=AMN
	infilet(28:29)=AYR
C
	infilec(12:13)=AYR
	infilec(15:16)=AMN
	infilec(20:21)=AMN
	infilec(28:29)=AYR
C
	infileh(12:13)=AYR
	infileh(15:16)=AMN
	infileh(20:21)=AMN
	infileh(28:29)=AYR
C
	infilef(12:13)=AYR
	infilef(15:16)=AMN
	infilef(20:21)=AMN
	infilef(28:29)=AYR

C day-to-day cycle
      imndy=im(imn)
       DO 40 idy=1,imndy
	CALL blet2(idy,ADY)
	infilet(22:23)=ADY
	infilec(22:23)=ADY
	infileh(22:23)=ADY
	infilef(22:23)=ADY
C
C UT cycle
       DO 41 iut=0,23
	call blet2(iut,AUT)
	infilet(24:25)=AUT
	infilec(24:25)=AUT
	infileh(24:25)=AUT
	infilef(24:25)=AUT
C
C Min cycle
C-       DO 42 imm=0,45,15
c      imm=0
C-	call blet2(imm,AMM)
C-	infilet(25:26)=AMM
C-	infilev(26:27)=AMM

	OPEN(11,file=infilet,action='READ')
	OPEN(12,file=infilec,action='READ')
	OPEN(13,file=infileh,action='READ')
	OPEN(14,file=infilef,action='READ')
C
      xmlat=-90.0	 ! mlatitude
C lati cycle
	DO nlat=1,70
	xmlat=xmlat+2.5
      xmlat2=xmlat+2.5
	read(11,31,end=45) itec
	read(12,31,end=46) ihc
	read(13,31,end=47) ihm
	read(14,31,end=147) ifc
	if ((gmlat.ge.xmlat).and.(gmlat.lt.xmlat2)) then	!++
C
	read(11,31,end=45) itec2
	read(12,31,end=46) ihc2
	read(13,31,end=47) ihm2
	read(14,31,end=147) ifc2
      xmlon=-5.0
	DO nlon=0,71  ! 
	xmlon=xmlon+5.0
      xmlon2=xmlon+5.0
	if ((gmlon.ge.xmlon).and.(gmlon.lt.xmlon2)) then  ! +++
c
	 restec11=itec(nlon)/10.0
	restec12=itec(nlon+1)/10.0
	 restec21=itec2(nlon)/10.0
	restec22=itec2(nlon+1)/10.0
C Interpolation:
	restec1=restec11+(restec21-restec11)/2.5*(gmlat-xmlat)
	restec2=restec12+(restec22-restec12)/2.5*(gmlat-xmlat)
	restecc=restec1+(restec2-restec1)/5.0*(gmlon-xmlon)
	irestec=int(restecc)

c
	 reshc11=ihc(nlon)*1.0
	reshc12=ihc(nlon+1)*1.0
	 reshc21=ihc2(nlon)*1.0
	reshc22=ihc2(nlon+1)*1.0
C Interpolation:
	reshc1=reshc11+(reshc21-reshc11)/2.5*(gmlat-xmlat)
	reshc2=reshc12+(reshc22-reshc12)/2.5*(gmlat-xmlat)
	reshc=reshc1+(reshc2-reshc1)/5.0*(gmlon-xmlon)
	ireshc=int(reshc)
c
	 reshm11=ihm(nlon)*1.0
	reshm12=ihm(nlon+1)*1.0
	 reshm21=ihm2(nlon)*1.0
	reshm22=ihm2(nlon+1)*1.0
C Interpolation:
	reshm1=reshm11+(reshm21-reshm11)/2.5*(gmlat-xmlat)
	reshm2=reshm12+(reshm22-reshm12)/2.5*(gmlat-xmlat)
	reshm=reshm1+(reshm2-reshm1)/5.0*(gmlon-xmlon)
	ireshm=int(reshm)
c
	 resfc11=ifc(nlon)/10.0
	resfc12=ifc(nlon+1)/10.0
	 resfc21=ifc2(nlon)/10.0
	resfc22=ifc2(nlon+1)/10.0
C Interpolation:
	resfc1=resfc11+(resfc21-resfc11)/2.5*(gmlat-xmlat)
	resfc2=resfc12+(resfc22-resfc12)/2.5*(gmlat-xmlat)
	resfc=resfc1+(resfc2-resfc1)/5.0*(gmlon-xmlon)
	iresfc=int(resfc*10.)
c
	xnm=resfc*resfc*1.24
	rtau=restecc/xnm
	irestau=nint(rtau*1000.)
c
	ktec(iut)=nint(restecc*10.)
      khc(iut)=ireshc
      khm(iut)=ireshm
	kf2(iut)=iresfc
	ktau(iut)=irestau
      exit
	endif					! +++
	ENDDO
C
      exit
	 endif !++
	ENDDO
   42 CONTINUE
   45	 close(unit=11)
   46		 close(unit=12)
   47		 close(unit=13)
  147 	 close(unit=14)
   41 CONTINUE
  138 format(3A2,24(1X,I4))
	write(*,138) AYR,AMN,ADY,(ktec(k),k=0,23)
	write(15,138) AYR,AMN,ADY,(ktec(k),k=0,23)
	write(*,138) AYR,AMN,ADY,(khc(k),k=0,23)
	write(16,138) AYR,AMN,ADY,(khc(k),k=0,23)
	write(*,138) AYR,AMN,ADY,(khm(k),k=0,23)
	write(17,138) AYR,AMN,ADY,(khm(k),k=0,23)
	write(*,138) AYR,AMN,ADY,(kf2(k),k=0,23)
 	write(18,138) AYR,AMN,ADY,(kf2(k),k=0,23)
	write(*,138) AYR,AMN,ADY,(ktau(k),k=0,23)
 	write(19,138) AYR,AMN,ADY,(ktau(k),k=0,23)
   40 CONTINUE
	close(unit=15)
	close(unit=16)
	close(unit=17)
	close(unit=18)
	close(unit=19)
C
   35      write(*,*) infilet,infilec,infileh,infilef
      pause ' ' 
	goto 1
      STOP
       END

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