C........................................................Dec 2020
C VU, VL, VE index along 35E weighted average: weights w(|Vi|) & e(lat)
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 delonjpl3
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)
C-     +,ipos3(9),ineg3(9),itot3(9)
     +,weg(4) ! 3h indices
	+,iwneg(0:24),iwpos(0:24),iwran(0:24)
C
	CHARACTER*2 AYR,AMN,ADY,AUT
C	+,AMM
	CHARACTER*4 AGLON
	CHARACTER*5 AGLONG
      CHARACTER*128 INFILEV,OUTFILEN,OUTFILEP,OUTFILER
C+,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 WEG/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 
      outfilen='d:\web\grif\datw\vlnYY35.txt'   !  Cnt(W-) 	 WL
      outfilep='d:\web\grif\datw\vupYY35.txt'   !  Cnt(W+) 	 WU
      outfiler='d:\web\grif\datw\verYY35.txt'   !  Cnt(Wrange) WE
C
 330       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

Coutfilvz='vrGLON.jyr'
coutfilvz(3:6)=AGLONG
c     outfilvz(9:10)=AYR
C
	outfilep(21:22)=ayr
	outfilen(21:22)=ayr
	outfiler(21:22)=ayr
C
	OPEN(11,file=outfilep,access='APPEND')
	OPEN(12,file=outfilen,access='APPEND')
	OPEN(13,file=outfiler,access='APPEND')
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
C	OPEN(14,file=outfilvz)
C
	infilev='D:\web\drs\YR\MN\viMNDDUT.jYR'
Cadd	infilev='D:\web\graf\dwc\YR\MN\ut\wcMNDDUT.jYR'   ! Temp Dec 2020
	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
C
      DO k=0,24
	iwneg(k)=0
	iwpos(k)=0
	iwran(k)=0
	ENDDO
	 wdyp=0.
	wdyn=0.
	wdyr=0.
       DO 41 iut=0,23
	call blet2(iut,AUT)
	infilev(24:25)=AUT
C
C Min cycle
	nn=nn+1
C-	call blet2(imm,AMM)
C-	infilev(26:27)=AMM

	OPEN(10,file=infilev,action='READ')
C
	sumn=0.		 ! count of Wf >=1
	sump=0.		 ! count of Wf <=-1
	icntp=0
	swegp=0.
      icntn=0
	swegn=0.
C
      xlat=-90.0
c-	coglat=90.0-glat
	coglon=360.-glon
C lati cycle
	DO nlat=1,71
	xlat=xlat+2.5
	elat=1.0+0.0001235*xlat**2	  ! AD
	coxlat=87.5-xlat
	read(10,31,end=46) ivs
C
      xlon=-185.0
	DO 333 nlon=0,72
	xlon=xlon+5.0
	coxlon=360.-xlon
	if (abs(coxlon-coglon).le.2.5) then  ! +++
      ivsr(nlat,nn)=ivs(nlon)
C++
          if (ivsr(nlat,nn).gt.1) then
        iad=ivsr(nlat,nn)
	sump=sump+elat*weg(iad)*ivsr(nlat,nn)  ! AD
	icntp=icntp+1
	swegp=swegp+weg(iad)
C?	goto 333
       exit
	endif
          if (ivsr(nlat,nn).lt.-1) then
        iad=-ivsr(nlat,nn)
	sumn=sumn+elat*weg(iad)*ivsr(nlat,nn)   ! AD
	icntn=icntn+1
	swegn=swegn+weg(iad)
C?	goto 333
       exit
	endif
C++
C?      exit
	endif					! +++
  333	CONTINUE   ! long cycle
C
	ENDDO	  ! lat cycle
   46		 close(unit=10)
      xpos=0.
      if (icntp.gt.0.) then
C		xpos=sump/swegp		 ! /sum(weights)
		xpos=sump/icntp		 ! /cnt(Wf+)
	endif
      xneg=0.
      if (icntn.gt.0.) then
C			xneg=sumn/swegn	  ! /sum(weights)
			xneg=sumn/icntn	  ! /cnt(Wf-)
	endif
	xrange=xpos-xneg
	wdyp=wdyp+xpos
	wdyn=wdyn+xneg
      wdyr=wdyr+xrange
      iwneg(iut)=nint(xneg*100.)
	iwpos(iut)=nint(xpos*100.)
	iwran(iut)=nint(xrange*100.)

   41 CONTINUE		 ! UT cycle

      iwpos(24)=nint(wdyp/24.*100.)
	iwneg(24)=nint(wdyn/24.*100.)
	iwran(24)=nint(wdyr/24.*100.)
	write(*,133) AYR,AMN,ADY,(iwpos(k),k=0,24)
	write(11,133) AYR,AMN,ADY,(iwpos(k),k=0,24)
	write(*,133) AYR,AMN,ADY,(iwneg(k),k=0,24)
	write(12,133) AYR,AMN,ADY,(iwneg(k),k=0,24)
	write(*,133) AYR,AMN,ADY,(iwran(k),k=0,24)
	write(13,133) AYR,AMN,ADY,(iwran(k),k=0,24)
  133 format(3A2,24(1X,I4),2X,I4)
C
   40 CONTINUE	! end day-to-day  cycle
   48	CONTINUE  ! end monthly cycle
      close(unit=11)
	close(unit=12)
	close(unit=13)
c      close(unit=14)
C
      if (iyr.ne.20) GOTO 330
   35      write(*,*) infilev
      pause ' ' 
      STOP
       END

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