C........................................................Aug. 2021
C Extract 3h WU,WL,WE-indices along glon=35E (wc) or mlong=120E (wo) Moscow meridiands for 3 days
C
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 delon3jpl35
C----------------------------------------------------------------
C
C      integer itecr(180,96),ivsr(180,96),IM(12)
C     +,itec(360),ivs(360)
      integer kn,nday,ivsr(0:23),IM(12) ! ivsr along glon for 00,01,...,23h
     +,ivs(73),iwures(0:23),iwlres(0:23),iweres(0:23)  ! 3days of 3h indices at each lati
      dimension weg(4) ! 3h indices
C
	CHARACTER*2 AYR,AMN,ADY,AUT
C	+,AMM
	CHARACTER*4 AGLON
	CHARACTER*5 AGLONG
      CHARACTER*128 INFILEV,outfilep,outfilen,outfiler
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*1 wco
	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
        wco='c'       ! geogr
C	wco='o'         ! geomagn
        if (wco.eq.'c') then
      	glon=35.0  !selected longitude 35E-meridian
	iglon=int(glon)
	      else
	glon=120.0
	      endif
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
C
       WRITE(*,*) ' Enter MN: '
	read(*,*) imn
C
       WRITE(*,*) ' Enter idy1,idy2: '
	read(*,*) idy1,idy2
C
	outfilep='wxGLONp.jyr'
       outfilep(2:2)=wco
	outfilep(3:6)=AGLONG
      outfilep(9:10)=AYR
	outfilen=outfilep
	outfilen(7:7)='n'
	outfiler=outfilep
	outfiler(7:7)='r'
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))
C
	OPEN(14,file=outfilep)
	OPEN(15,file=outfilen)
	OPEN(16,file=outfiler)
C
	infilev='D:\web\dws\YR\MN\wxMNDDUT.jYR'
      infilev(19:19)=wco
	infilev(12:13)=AYR
	infilev(28:29)=AYR
C
c-	imn2=12
c-	if (iyr.eq.20) imn2=10      !TEMP for Oct.2020
c-      DO 48 imn=1,imn2

	call blet2(imn,AMN)
	infilev(15:16)=AMN
	infilev(20:21)=AMN
	ndmn=im(imn)
C
C
C day-to-day cycle
c       DO 40 idy=1,ndmn
        nday=0
	kn=0
       DO 40 idy=idy1,idy2
	nday=nday+1
	kn=(nday-1)*8
	CALL blet2(idy,ADY)
	infilev(22:23)=ADY
C
       nn=0           ! cnt hr for given day
C UT cycle  
C Read maps for 3successive hours
       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(iut)=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
C 3-h indices
C lati cycle
       glat=-90.0	                  ! AD
	 DO 333 ilat=1,71
 	glat=glat+2.5				  ! AD
 	elat=1.0+0.0001235*glat**2	  ! AD
      dypos=0.
	dyneg=0.
	sumn=0.		 !3h count of Vs >1
	sump=0.		 !3h count of Vs <-1
	icntp=0
	swegp=0.
      icntn=0
	swegn=0.
        do kk=0,23
      iwures(kk)=0
	iwlres(kk)=0
	iweres(kk)=0
	enddo
C
	DO 332 ihr=1,8   ! 8 3-h intervals
	kn=kn+1
	k1=(ihr-1)*3
	k2=k1+2
C
       DO 331 kk=k1,k2			 !**
          if (ivsr(kk).gt.1) then
        iad=ivsr(kk)
	sump=sump+elat*weg(iad)*ivsr(kk)
	icntp=icntp+1
	swegp=swegp+weg(iad)
	goto 331
	endif
          if (ivsr(kk).lt.-1) then
        iad=-ivsr(kk)
	sumn=sumn+elat*weg(iad)*ivsr(kk)
	icntn=icntn+1
	swegn=swegn+weg(iad)
	goto 331
	endif
 331	CONTINUE			!**
      xpos=0.
      if (icntp.gt.0.) then
C		xpos=sump/swegp		 ! /sum(weights)
		xpos=sump/icntp		 ! /cnt(W+)
	endif
      xneg=0.
      if (icntn.gt.0.) then
C			xneg=sumn/swegn	  ! /sum(weights)
			xneg=sumn/icntn	  ! /cnt(W-)
	endif
	xrange=xpos-xneg
	iwures(kn)=nint(xpos*100.)
	iwlres(kn)=nint(xneg*100.)
	iweres(kn)=nint(xrange*100.)
  332	CONTINUE                   ! end 8 3-h intervals
	write(*,33) AYR,AMN,glat,(iwures(k),k=0,23)
	write(14,33) AYR,AMN,glat,(iwures(k),k=0,23)
	write(*,33) AYR,AMN,glat,(iwlres(k),k=0,23)
	write(15,33) AYR,AMN,glat,(iwlres(k),k=0,23)
	write(*,33) AYR,AMN,glat,(iweres(k),k=0,23)
	write(16,33) AYR,AMN,glat,(iweres(k),k=0,23)
  333	CONTINUE
C
   40 CONTINUE	! end day-to-day  cycle
C
      glat=-90.
         do ilat=1,71
	glat=glat+2.5
	 enddo 
   48	CONTINUE  ! end monthly cycle
      close(unit=14)
	close(unit=15)
	close(unit=16)
   33 FORMAT(1X,2A2,1X,F5.1,24(1X,I5))
C
   35      write(*,*) infilev,outfilep,outfilen,outfiler
      pause ' ' 
      STOP
       END

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