C........................................................Oct.2020
C Extract fixed Vs-index from JPLi 15-min files (1 x 1 deg)
C along selected longitute for total day: 
C longs=-179.5:1:179.5
C lats -89.5:1:89.5
C Weighted percentage Vzp, Vzn,% occurrence (for every 3 hrs) from dayly jpli 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 decodjpli2
C----------------------------------------------------------------
C
C      integer itecr(180,96),ivsr(180,96),IM(12)
C     +,itec(360),ivs(360)
      integer ivsr(180,96),IM(12)
     +,ivs(360)
     +,ipos3(9),ineg3(9),itot3(9),iweg(4) ! 3h indices
C
	CHARACTER*2 AYR,AMN,ADY,AUT,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
	glon=0.0  !selected longitude 0-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='vsGLON.jyr'
	outfilvz(3:6)=AGLONG
      outfilvz(9:10)=AYR
C
C
   30 FORMAT(1X,2A2,1X,I2,1X,F6.1)
   31 FORMAT(360(1X,I4))
   32 FORMAT(96(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\vlMNDDUTMM.jYR'
	infilev(12:13)=AYR
	infilev(30:31)=AYR
C
      DO 48 imn=1,12
	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
       DO 42 imm=0,45,15
	nn=nn+1
	call blet2(imm,AMM)
	infilev(26:27)=AMM

	OPEN(12,file=infilev,action='READ')
C
      xlat=-90.5
c-	coglat=90.0-glat
	coglon=360.-glon
C lati cycle
	DO nlat=1,180
	xlat=xlat+1.0
	coxlat=90.0-xlat
	read(12,31,end=46) ivs
C
      xlon=-180.5
	DO nlon=1,360
	xlon=xlon+1.0
	coxlon=360.-xlon
	if (abs(coxlon-coglon).le.0.5) then  ! +++
      ivsr(nlat,nn)=ivs(nlon)
      exit
	endif					! +++
	ENDDO   ! long cycle
C
	ENDDO	  ! lat cycle
   46		 close(unit=12)
   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
      dypos=0.
	dyneg=0.
C 3-h indices
C
	DO ihr=1,8   ! 8 3-h intervals
	k1=(ihr-1)*12+1
	k2=k1+11
	sumn=0.		 !3h count of Vs >=1
	sump=0.		 !3h count of Vs <=-1
C
        DO kk=k1,k2			 !**
	 DO 333 ilat=1,180
          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					!**
	xpos3=sump/68.6664
	xneg3=sumn/68.6664
	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***********************************************************
