C........................................................Nov.2020
C Extract fixed Vs-index from JPL 1h files (2.5 x 5 deg) IONEX format
C along selected longitute for total day: 
C longs=-180.0:5:180.0
C lats -87.5:2.5:87.5
C Weighted percentage Vzp, Vzn,% occurrence (for every 3 hrs) from dayly jpl results Vsigma
C input 
C       Vs : D:\web\drs\YR\MN\vlMNDDUTMM.jYR index file
C output <vztLON.jYR>
C +Output : 3h zonal indices Vsp, Vsn, Vtot
C 4min*24h*180lat =  17280 grids/diurnal
C 4min*3h*180lat=2160grids/3h
C 
      PROGRAM delonjpl2
C----------------------------------------------------------------
C
C      integer itecr(180,96),ivsr(180,96),IM(12)
C     +,itec(360),ivs(360)
      integer ivsr(71,73),IM(12)
     +,ivs(73)
     +,ipos3(9),ineg3(9),itot3(9),iweg(4) ! 3h indices
C
	CHARACTER*2 AYR,AMN,ADY,AUT
C	+,AMM
	CHARACTER*4 AGLON
	CHARACTER*5 AGLONG
      CHARACTER*128 INFILEV,outfilvz
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	DATA IWEG/0.,0.6931,1.0986,1.3863/  ! =ln1, ln2, ln3, ln4
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
Ctemp	glon=0.0  !selected longitude 0-meridian
      	glon=35.0  !selected longitude 35E-meridian
	iglon=int(glon)
C
 	if (iglon.lt.0) then 
 	mglon=-iglon
	call blet3(mglon,AGLON)
	AGLONG(1:1)='-'
	AGLONG(2:4)=AGLON
	else
	call blet3(iglon,AGLON)
	AGLONG(1:1)='t'
	AGLONG(2:4)=AGLON
	      endif
C 
       WRITE(*,*) ' Enter YR: '
	read(*,*) AYR
	read(AYR,*) ryr
	iyr=int(ryr)
	if(int(ryr/4.)*4.eq.iyr) THEN 
 	im(2)=29
	                          ELSE
	im(2)=28
	ENDIF

	outfilvz='viGLON.jyr'
	outfilvz(3:6)=AGLONG
      outfilvz(9:10)=AYR
C
C
   30 FORMAT(1X,2A2,1X,I2,1X,F6.1)
   31 FORMAT(73(1X,I4))
C   32 FORMAT(96(1X,I4))
   32 FORMAT(24(1X,I4))
   33 FORMAT(1X,3A2,9(1X,I2),9(1X,I3),9(1X,I2))
C
	OPEN(14,file=outfilvz)
C
	infilev='D:\web\drs\YR\MN\viMNDDUT.jYR'
	infilev(12:13)=AYR
	infilev(28:29)=AYR
C
	imn2=12
	if (iyr.eq.20) imn2=10      !TEMP for Oct.2020
      DO 48 imn=1,imn2

	call blet2(imn,AMN)
	infilev(15:16)=AMN
	infilev(20:21)=AMN
	ndmn=im(imn)
C
C day-to-day cycle
       DO 40 idy=1,ndmn
	CALL blet2(idy,ADY)
	infilev(22:23)=ADY
C
       nn=0           ! cnt hr,min for given day
C UT cycle
       DO 41 iut=0,23
	call blet2(iut,AUT)
	infilev(24:25)=AUT
C
C Min cycle
C-       DO 42 imm=0,45,15
	nn=nn+1
C-	call blet2(imm,AMM)
C-	infilev(26:27)=AMM

	OPEN(12,file=infilev,action='READ')
C
      xlat=-90.0
c-	coglat=90.0-glat
	coglon=360.-glon
C lati cycle
	DO nlat=1,71
	xlat=xlat+2.5
	coxlat=87.5-xlat
	read(12,31,end=46) ivs
C
      xlon=-185.0
	DO nlon=0,72
	xlon=xlon+5.0
	coxlon=360.-xlon
	if (abs(coxlon-coglon).le.2.5) then  ! +++
      ivsr(nlat,nn)=ivs(nlon)
      exit
	endif					! +++
	ENDDO   ! long cycle
C
	ENDDO	  ! lat cycle
   46		 close(unit=12)
C-   42 CONTINUE	   ! min cycle
   41 CONTINUE		 ! UT cycle

C 4min*24h*180lat =  17280 grids/diurnal
C 4min*3h*180lat=2160grids/3h
C include weight=2. for Vpos=4, Vneg=-4
C
C    24h*71lat = 1704	 grids/diurnal
C     3h*71lat=	213	 grids/3h
C
      dypos=0.
	dyneg=0.
C 3-h indices
C
	DO ihr=1,8   ! 8 3-h intervals
C	k1=(ihr-1)*12+1
	k1=(ihr-1)*3+1
C	k2=k1+11
	k2=k1+2
	sumn=0.		 !3h count of Vs >=1
	sump=0.		 !3h count of Vs <=-1
C
        DO kk=k1,k2			 !**
	 DO 333 ilat=1,71
          if (ivsr(ilat,kk).gt.0) then
        iad=ivsr(ilat,kk)
	sump=sump+iweg(iad)*ivsr(ilat,kk)
	goto 333
	endif
          if (ivsr(ilat,kk).lt.0) then
        iad=-ivsr(ilat,kk)
	sumn=sumn+iweg(iad)*ivsr(ilat,kk)
	goto 333
	endif
  333	CONTINUE
	  ENDDO					!**
C	xpos3=sump/68.6664 !  	xpos3=sump/(3.179*2160)*100% ; w1+w2+w3+w4=3.179
	xpos3=sump/6.77127 !  	xpos3=sump/(3.179*213)*100%	 =sump/	677.127*100%
C	xneg3=sumn/68.6664
	xneg3=sumn/6.77127 !  	xneg3=sumn/(-3.179*213)*100% =sumn/	677.127*100%
	ipos3(ihr)=nint(xpos3)
	ineg3(ihr)=nint(xneg3)
	itot3(ihr)=ipos3(ihr)-ineg3(ihr)
	dypos=dypos+xpos3
	dyneg=dyneg+xneg3
	ENDDO               ! end 8 3-h intervals
	ipos3(9)=nint(dypos/8.)
	ineg3(9)=nint(dyneg/8.)
	itot3(9)=ipos3(9)-ineg3(9)
	write(*,33) AYR,AMN,ADY,(ipos3(k),k=1,9),(ineg3(k),k=1,9)
	+,(itot3(k),k=1,9)
	write(14,33) AYR,AMN,ADY,(ipos3(k),k=1,9),(ineg3(k),k=1,9)
	+,(itot3(k),k=1,9)
   40 CONTINUE	! end day-to-day  cycle
   48	CONTINUE  ! end monthly cycle
      close(unit=14)
C
   35      write(*,*) infilev,outfilvz
      pause ' ' 
      STOP
       END

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