C........................................................Apr.2019
C Extract fixed TEC, hoF2, foF2, Hc 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 decodjplr
C----------------------------------------------------------------
C
      integer itec(0:72),ihc(0:72),ihm(0:72)
C
	CHARACTER*2 AYR,AMN,ADY,AUT
	CHARACTER*4 AGLAT,AGLON
	CHARACTER*5 AGLONG
      CHARACTER*128 INFILET,INFILEC,INFILEH,OUTFILE
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
C++
C
      ICALLS=0
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C+       WRITE(*,*) ' Enter glati: '
C+	read(*,*) glat
C+       WRITE(*,*) ' Enter glong: '
C+	read(*,*) glon
C Temp
C+       glat=69.66 !Tromso tro1
C+	glon=18.94  !Tromso tro1
       glat=45.0 !Bruno test mag lat
	glon=95.0  !Bruno test mag lon

	iglat=int(glat*10.)
	iglon=int(glon*10.)
C
	if (iglat.lt.0) then 
	mglat=-iglat
	call blet4(mglat,AGLAT)
	AGLAT(1:1)='-'
	else
	call blet4(iglat,AGLAT)
	AGLAT(1:1)='x'
	      endif
C- 	if (iglon.lt.0) then 
C- 	mglon=-iglon
C-	call blet4(mglon,AGLON)
C-	AGLONG(1:1)='-'
C-	AGLONG(2:5)=AGLON
C-	else
	call blet4(iglon,AGLON)
	AGLONG(1:1)='x'
	AGLONG(2:5)=AGLON
C-	      endif
C 
       WRITE(*,*) ' Enter YR: '
	read(*,*) AYR
    1   WRITE(*,*) ' Enter MN: '
	read(*,*) AMN
       WRITE(*,*) ' Enter iDY1,iDY2: '
	read(*,*) idy1,idy2
C
 	outfile='thcMLATMLONG.res'
	outfile(4:7)=AGLAT
	outfile(8:12)=AGLONG
C
   30 FORMAT(1X,2A2,2(1X,I2),2(1X,F6.1))
   31 FORMAT(73(1X,I4))
   32 FORMAT(1X,4A2,1X,F5.1,3(1X,I4))
C
	OPEN(10,file=outfile,access='APPEND')
	WRITE(*,30) AYR,AMN,idy1,idy2,glat,glon ! =mlat,mlon
	WRITE(10,30) AYR,AMN,idy1,idy2,glat,glon ! =mlat,mlon

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'
	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 day-to-day cycle
       DO 40 idy=idy1,idy2
	CALL blet2(idy,ADY)
	infilet(22:23)=ADY
	infilec(22:23)=ADY
	infileh(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
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')
C
      xlat=-90.0
	coglat=90.0-glat
C-	coglon=360.-glon
C lati cycle
	DO nlat=1,71
	xlat=xlat+2.5
	coxlat=90.0-xlat
	read(11,31,end=45) itec
	read(12,31,end=46) ihc
	read(13,31,end=47) ihm
	if (abs(coxlat-coglat).lt.1.25) then	!++
C
      xlon=-5.0
	DO nlon=0,72
	xlon=xlon+5.0
C-	coxlon=360.-xlon
C-	if (abs(coxlon-coglon).lt.0.5) then  ! +++
	if (abs(xlon-glon).lt.2.5) then  ! +++
	restec=itec(nlon)/10.
	ireshc=ihc(nlon)
	ireshm=ihm(nlon)
	idev=ireshc-ireshm
C	iresvs=ivs(nlon)
	write(*,32) AYR,AMN,ADY,AUT,restec,ireshc,ireshm,idev
	write(10,32) AYR,AMN,ADY,AUT,restec,ireshc,ireshm,idev
      exit
	endif					! +++
	ENDDO
C
      exit
	 endif !++
	ENDDO
   42 CONTINUE
   45	 close(unit=11)
   46		 close(unit=12)
   47		 close(unit=13)

   41 CONTINUE

   40 CONTINUE
	close(unit=10)
C
   35      write(*,*) infilet,infilec,infileh,outfile
      pause ' ' 
	goto 1
      STOP
       END

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