C........................................................Jan.2020
C Extract fixed TEC or Vs-index from JPLi 15-min files (1 x 1 deg)
C longs=-179.5:1:179.5
C lats -89.5:1:89.5
C input TEC; D:\UTEC\YEAR\MN\tiMNDDUTMM.jYR> IONEXi files
C       Wg(TEC) : D:\web\dlg\YR\MN\wgMNDDUTMM.jYR index file
C output <twstat.jYR>
C 
C Select period of 72hrs starting from t0-24h, ending t0+48h; t0 @ Dstmin
C 
      PROGRAM decodjplimm1
C----------------------------------------------------------------
C
      integer itec(360),iwg(360)
	DIMENSION dstorm(365),lday(365)
C
	CHARACTER*2 AYR,AMN,ADY,AUT,AMM
	+,DYR(364),DMN(364),DDY(364),DUT(364)
	CHARACTER*4 AGLAT,AGLON,STAT
	CHARACTER*5 AGLONG
      CHARACTER*128 INFILET,INFILEW,INFDST,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
C Dst 364 storms from 2000 to 2017
C
   28 format(24X,2I2,2(1X,I2),1X,F4.0)
	INFDST='dstpart.txt'
	open(10,file=infdst,action='READ')
	DO ii=1,365
	read(10,28,end=27) iyr,imn,idy,iut,dstmin
      lda=ndoy(iyr,imn,idy)-1 ! -1d
	call submmdd(lda,iyr,imn,idy)
C
	call blet2(iyr,AYR)
	call blet2(imn,AMN)
	call blet2(idy,ADY)
	call blet2(iut,AUT)
	DYR(ii)=AYR
	DMN(ii)=AMN
	DDY(ii)=ADY
	DUT(ii)=AUT
	dstorm(ii)=dstmin
	lday(ii)=lda
	ENDDO
   27 close(unit=10)
C
C+       WRITE(*,*) ' Enter glati: '
C+	read(*,*) glat
C+       WRITE(*,*) ' Enter glong: '
C+	read(*,*) glon
C Temp                                                  glat   glong   mlat  mlong
CKIRU+ Kiruna           Sweden                          67.86   20.97  65.3  115.9
CMOBN+ Obninsk          Rssian Federation               55.11   36.57	 50.8  120.9
CNICO+ Nicosia          Cyprus                          35.14   33.40	 31.9  111.8
CADIS+ Addis Ababa      Ethiopia                         9.04   38.77	  5.3  112.0
CZAMB+ Lusaka           Zambia                         -15.43   28.31 -17.0   97.4
CSUTM+ Sutherland       South Africa                   -32.38   20.81 -32.3   86.4
CCZTG+ Alfred-Faure     French Southern Territories    -46.43   51.86	-51.3  113.8
CSYOG+ East Ongle Island Antarctica                    -69.01   39.58	-70.4   84.3

C+       glat=55.1 !Obninsk mobn
C+	glon=36.6  !Obninsk mobn
C+       glat=39.9 !Ankara ankr
C+	glon=32.8  !Ankara ankr
C+       glat=35.1 !Nicosia nico
C+	glon=33.4  !Obninsk nico
C+       glat=35.7 !Koganei kgni
C+	glon=139.5  !Koganei kgni
C+       glat=-14.38 !Katherine kate
C+	glon=132.15  !Katherine kate
C+       glat=-20.98 !Karratha karr
C+	glon=117.1  !Karratha karr
C+       glat=69.66 !Tromso tro1
C+	glon=18.94  !Tromso tro1
C       glat=67.86    !KIRU
C	glon=20.97  !KIRU
C	stat='KIRU'
C	iglat=int(glat*10.)
C	iglon=int(glon*10.)
C       glat=55.11    !MOBN
C	glon=36.57 !MOBN
C	stat='MOBN'
C	iglat=int(glat*10.)
C	iglon=int(glon*10.)
C       glat=35.14    !NICO
C	glon=33.40 !NICO
C	stat='NICO'
C	iglat=int(glat*10.)
C	iglon=int(glon*10.)
C       glat= 9.04    !ADIS
C	glon= 38.77 !ADIS
C	stat='ADIS'
       glat=-15.43    !ZAMB
	glon=28.31 !ZAMB
	stat='ZAMB'
C
	iglat=int(glat*10.)
	iglon=int(glon*10.)

	if (iglat.lt.0) then 
	mglat=-iglat
	call blet4(mglat,AGLAT)
	AGLAT(1:1)='-'
	else
	call blet4(iglat,AGLAT)
	AGLAT(1:1)='x'
	      endif
 	if (iglon.lt.0) then 
 	mglon=-iglon
	call blet4(mglon,AGLON)
	AGLONG(1:1)='-'
	AGLONG(2:5)=AGLON
	else
	call blet4(iglon,AGLON)
	AGLONG(1:1)='x'
	AGLONG(2:5)=AGLON
	      endif
C 
Crem       WRITE(*,*) ' Enter YR: '
Crem	read(*,*) AYR
Crem       WRITE(*,*) ' Enter MN: '
Crem	read(*,*) AMN
Crem       WRITE(*,*) ' Enter iDY1,iDY2: '
Crem	read(*,*) idy1,idy2
C
 	outfile='twGLATGLONG.jYR'
	outfile(3:6)=AGLAT
	outfile(7:11)=AGLONG
C
C Cycle on Dst storms
        DO 127 ii=1,365
C	if (ii.lt.278) goto 127
      AYR=DYR(ii)
 	AMN=DMN(ii)
	ADY=DDY(ii)
	AUT=DUT(ii)
	dstmin=dstorm(ii)
	lda1=lday(ii)
	lda2=lda1+3
C
	read(ady,*) rdy
	idy1=int(rdy)
	idy2=idy1+3
	read(aut,*) rut
	iut0=int(rut)
	if (iut0.eq.0) idy2=idy1+2
C
	outfile(14:15)=AYR
C
   29 FORMAT(1X,A4)
   30 FORMAT(1X,2A2,2(1X,I2),3(1X,F6.1))
   31 FORMAT(360(1X,I4))
   32 FORMAT(1X,5A2,1X,F5.1,1X,I4)
   33 FORMAT(359(1X,I4))
C
	OPEN(10,file=outfile,access='APPEND')
	write(*,29)
	WRITE(*,30) AYR,AMN,idy1,idy2,glat,glon,dstmin
	WRITE(10,30) AYR,AMN,idy1,idy2,glat,glon,dstmin

	infilet='D:\UTEC\20YR\MN\tiMNDDUTMM.jYR'
	infilew='D:\web\dlg\YR\MN\wgMNDDUTMM.jYR'
	infilet(11:12)=AYR
	infilet(29:30)=AYR
	infilew(12:13)=AYR
	infilew(30:31)=AYR
C
C day-to-day cycle
C-       DO 40 idy=idy1,idy2
       DO 40 lda=lda1,lda2
	read(AYR,*) ryr
	iyr=int(ryr)
	call submmdd(lda,iyr,imn,idy)
C
	call blet2(imn,AMN)
	infilet(14:15)=AMN
	infilet(19:20)=AMN
	infilew(15:16)=AMN
	infilew(20:21)=AMN

	CALL blet2(idy,ADY)
	infilet(21:22)=ADY
	infilew(22:23)=ADY
C
C UT cycle
        if (lda.eq.lda1) then
	iut1=iut0
	iut2=23
	goto 141
	endif
        if ((lda.gt.lda1).and.(lda.lt.lda2)) then
	iut1=0
	iut2=23
	                else
      iut1=0
	iut2=iut0-1
	if (iut2.lt.0) iut2=23
	endif
  141  DO 41 iut=iut1,iut2
	call blet2(iut,AUT)
	infilet(23:24)=AUT
	infilew(24:25)=AUT
C
C Min cycle
       DO 42 imm=0,45,15
c      imm=0
	call blet2(imm,AMM)
	infilet(25:26)=AMM
	infilew(26:27)=AMM

	OPEN(11,file=infilet,action='READ')
	OPEN(12,file=infilew,action='READ')
C
      xlat=-90.5
	coglat=90.0-glat
	coglon=360.-glon
C lati cycle
	DO nlat=1,180
	xlat=xlat+1.0
	coxlat=90.0-xlat
	read(11,31,end=45) itec
	read(12,31,end=46) iwg
	if (abs(coxlat-coglat).lt.0.5) then	!++
C
      xlon=-180.5
	DO nlon=1,360
	xlon=xlon+1.0
	coxlon=360.-xlon
	if (abs(coxlon-coglon).lt.0.5) then  ! +++
	restec=itec(nlon)/10.
	ireswg=iwg(nlon)
C++	write(*,32) AYR,AMN,ADY,AUT,AMM,restec,ireswg
	write(10,32) AYR,AMN,ADY,AUT,AMM,restec,ireswg
      exit
	endif					! +++
	ENDDO
C
	 endif !++
	ENDDO
   42 CONTINUE
   45	 close(unit=11)
   46		 close(unit=12)
   41 CONTINUE

   40 CONTINUE
	close(unit=10)
  127 CONTINUE
C
   35      write(*,*) infilet,infilew,outfile,stat
      pause ' ' 
      STOP
       END

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