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
C NEW: glat= -85,-80,-70,...,80,85 (22 mlats) at glon=0 (LT=UT); output: Hc(modip,LT=0:1:23)
C 
      PROGRAM decodjplr2
C----------------------------------------------------------------
C
      integer ihc(0:72),ihc2(0:72),khc(0:23),IM(12)
cx	+,itec(0:72),ihm(0:72),if2(0:72)
cx	+,ktec(0:23),khm(0:23),kf2(0:23),ktau(0:23)
	 REAL amlats(22),amlons(22),amodip(22)
cx	+ glats(71,0:72),glons(71,0:72)
Cx	+,alats(22),alons(22)
	CHARACTER*2 AYR,AMN,ADY,AUT,ST,CMN,CDY
	CHARACTER*4 CYEAR,TIME
      CHARACTER*128 INFILEC,OUTFILEC !c-o-m
cx	+,INFILET,INFILEF,INFILEH
Cx	+,OUTFILET,OUTFILEF,OUTFILEH,OUTFILES ! TEC,fcF2,hmF2,tau
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*56 txt3,txt4,txt6
	CHARACTER*16 txt2,txt5
	CHARACTER*13 stname
cx	+,inglats,inglons
	CHARACTER*7 txt1
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA amlats/-77.2,-73.5,-64.8,-55.4,-45.8,-36.1,-26.3,-16.5,-6.6
	+,-1.7,3.2,10.1,14.1,18.0,22.9,32.7,42.5,52.2,61.7,70.7,78.1,80.0/
	DATA amlons/21.8,35.5,49.7,56.8,61.1,64.1,66.5,68.4,70.2,71.1,71.9
	+,73.2,73.9,74.6,75.6,77.8,80.5,84.3,90.1,101.0,126.9,151.5/
	DATA amodip/-76.5,-70.5,-61.9,-56.2,-53.3,-51.7,-49.7,-45.9,-38.4
	+,-32.5,-24.5,-9.7,0.1,9.9,21.0,37.3,47.5,54.7,60.7,66.8,74.0,78.8/
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

Cxx       gmlat=52.55 !HERS mag lat ~ geogr. 50.87
Cxx	gmlon=85.01  !HERS mag lon ~ geogr.  0.34 UT=LT!!!
Cxx	glat=50.9
Cxx	glon=0.3
	st='hc' ! C-o-M at GLON=0.0
	stname=' Glon=0.0    '
C 
C Read geogr. coords. for magn. grids
  171	format(73(1X,F5.1))
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
       WRITE(*,*) ' Enter ADY: '
	read(*,*) ady
	read(ady,*) rdy
	idy1=int(rdy)
	idy2=idy1
C
      txt3(1:2)=AYR
	txt3(3:4)=AMN
	txt3(5:6)=ADY

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
	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
C        outfilet='d:\web\dat7\YR\stYRMNt.txt'
C	outfilef='d:\web\dat1\YR\stYRMN.txt'
C	outfileh='d:\web\dat6\YR\stYRMNh.txt'
C	outfiles='d:\web\dat9\YR\stYRMNs.txt'
	outfilec='d:\web\dat8\YR\stYRMNDYc.txt'
	outfilec(13:14)=AYR
	outfilec(16:17)=ST
	outfilec(18:19)=AYR
	outfilec(20:21)=AMN
	outfilec(22:23)=ADY
C
cx	outfilef(13:14)=AYR
cx	outfilef(16:17)=ST
cx	outfilef(18:19)=AYR
cx	outfilef(20:21)=AMN
C
cx	outfileh(13:14)=AYR
cx	outfileh(16:17)=ST
cx	outfileh(18:19)=AYR
cx	outfileh(20:21)=AMN
C
cx	outfiles(13:14)=AYR
cx	outfiles(16:17)=ST
cx	outfiles(18:19)=AYR
cx	outfiles(20:21)=AMN
C
cx	outfilet(13:14)=AYR
cx	outfilet(16:17)=ST
cx	outfilet(18:19)=AYR
cx	outfilet(20:21)=AMN
C
cx	OPEN(15,file=outfilet)
	OPEN(16,file=outfilec)
cx	OPEN(17,file=outfileh)
cx	OPEN(18,file=outfilef)
cx	OPEN(19,file=outfiles)
  130	format(A13,1X,A7)    ! 
  136	format(A16,A4,2A2,1X,'Time = ',A4,1X)
  137	format(2A56,A16,1X)

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

C	infilet='D:\UTEC\20YR\MN\tiMNDDUTMM.jYR'
CC	infilev='D:\web\drs\YR\MN\vlMNDDUTMM.jYR'
cx	infilet='d:\web\dts\YR\MN\toMNDDUT.jYR'
cx	infileh='d:\web\dhs\YR\MN\hoMNDDUT.jYR'
	infilec='d:\web\dhc\YR\MN\coMNDDUT.jYR'
cx	infilef='d:\web\dfs\YR\MN\foMNDDUT.jYR'
cx	infilet(12:13)=AYR
cx	infilet(15:16)=AMN
cx	infilet(20:21)=AMN
cx	infilet(28:29)=AYR
C
	infilec(12:13)=AYR
	infilec(15:16)=AMN
	infilec(20:21)=AMN
	infilec(28:29)=AYR
C
cx	infileh(12:13)=AYR
cx	infileh(15:16)=AMN
cx	infileh(20:21)=AMN
cx	infileh(28:29)=AYR
C
cx	infilef(12:13)=AYR
cx	infilef(15:16)=AMN
cx	infilef(20:21)=AMN
cx	infilef(28:29)=AYR
C
C   Cycle on Modip (glat,glon)
C
         DO 44 iii=1,22
	gmlat=amlats(iii)
	gmlon=amlons(iii)
	gmodip=amodip(iii)

C day-to-day cycle
      imndy=im(imn)
cx       DO 40 idy=1,imndy
        idy=idy1
cx	CALL blet2(idy,ADY)
cx	infilet(22:23)=ADY
	infilec(22:23)=ADY
cx	infileh(22:23)=ADY
cx	infilef(22:23)=ADY
C
C UT cycle
       DO 41 iut=0,23
	call blet2(iut,AUT)
cx	infilet(24:25)=AUT
	infilec(24:25)=AUT
cx	infileh(24:25)=AUT
cx	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

cx	OPEN(11,file=infilet,action='READ')
	OPEN(12,file=infilec,action='READ')
cx	OPEN(13,file=infileh,action='READ')
cx	OPEN(14,file=infilef,action='READ')
C
      xmlat=-90.0
C mlati cycle
	DO nlat=1,70
	xmlat=xmlat+2.5
	xmlat2=xmlat+2.5
cx	read(11,31,end=45) itec
	read(12,31,end=46) ihc
cx	read(13,31,end=47) ihm
cx	read(14,31,end=147) if2
	if ((gmlat.ge.xmlat).and.(gmlat.lt.xmlat2)) then	!++
	read(12,31,end=46) ihc2
C
      xmlon=-5.0
	DO nlon=0,71  ! 
	xmlon=xmlon+5.0
      xmlon2=xmlon+5.0
	if ((gmlon.ge.xmlon).and.(gmlon.lt.xmlon2)) then  ! +++
cx	restec1=itec(nlon)/10.
cx	restec2=itec(nlon+1)/10.
cx	restec=restec1+(restec2-restec1)*(glon-g1)/(g2-g1)
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=nint(reshc)
c
cx	 reshm1=ihm(nlon)*1.0
cx	reshm2=ihm(nlon+1)*1.0
cx	reshm=reshm1+(reshm2-reshm1)*(glon-g1)/(g2-g1)
cx	ireshm=int(reshm)
c
cx	 fm1=float(if2(nlon))/10.
cx	fm2=float(if2(nlon+1))/10.
cx	ff2=fm1+(fm2-fm1)*(glon-g1)/(g2-g1)
cx	iresfm=int(ff2*10.)
c
cx	xnm=ff2*ff2*1.24
cx	rtau=restec/xnm
cx	irestau=nint(rtau*1000.)
c
cx	ktec(iut)=nint(restec*10.)
      khc(iut)=ireshc
cx    khm(iut)=ireshm
cx	kf2(iut)=iresfm
cx	ktau(iut)=irestau
      exit
	endif					! +++
	ENDDO
C
      exit
	                         endif !++
	ENDDO
   42 CONTINUE
cx  45	 close(unit=11)
   46		 close(unit=12)
cx   47		 close(unit=13)
cx  147 	 close(unit=14)
   41 CONTINUE
  138 format(3A2,24(1X,I4))
  139 format(1X,F5.1,24(1X,I4))
cx	write(*,138) AYR,AMN,ADY,(ktec(k),k=0,23)
cx	write(15,138) AYR,AMN,ADY,(ktec(k),k=0,23)
cx	write(*,138) AYR,AMN,ADY,(khc(k),k=0,23)
cx	write(16,138) AYR,AMN,ADY,(khc(k),k=0,23)
	write(*,139) gmodip,(khc(k),k=0,23)
	write(16,139) gmodip,(khc(k),k=0,23)
cx	write(*,138) AYR,AMN,ADY,(khm(k),k=0,23)
cx	write(17,138) AYR,AMN,ADY,(khm(k),k=0,23)
cx	write(*,138) AYR,AMN,ADY,(kf2(k),k=0,23)
cx 	write(18,138) AYR,AMN,ADY,(kf2(k),k=0,23)
cx	write(*,138) AYR,AMN,ADY,(ktau(k),k=0,23)
cx 	write(19,138) AYR,AMN,ADY,(ktau(k),k=0,23)
   40 CONTINUE
   44 CONTINUE
cx	close(unit=15)
	close(unit=16)
cx	close(unit=17)
cx	close(unit=18)
cx	close(unit=19)
C
C
C   35      write(*,*) infilet,infilec,infileh,infilef
   35      write(*,*) infilec,outfilec
      pause ' ' 
	goto 1
      STOP
       END

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