      program extpianiaWj3ab
C.........................................................Aug. 2021
C Arbitrary dates 3h WU,WL,WE
C.........................................................Dec. 2020
C Include weight e(glat)
C
C Weighted PIA -pos ion activity, NIA - neg ion activity
C extracted from global Wc(TEC) index derived from JPL GIM-TEC (IONEX)
C
	DIMENSION weg(4),IM(12),wneg(0:8),wpos(0:8),wran(0:8)
	CHARACTER*128 INFILE,OUTFILE !global weighted Wfp,Wfn,Wfr = range index
	CHARACTER*1 ab
	CHARACTER*2 AYR,AUT,AMN,ADY
C	+,AUTOUT(0:7)
	INTEGER ivsr(0:72) !  set of Wf indices for long=-10:5:180 at given lati
		DATA WEG/0.,0.6931,1.0986,1.3863/  ! =ln1, ln2, ln3, ln4
            DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
C--	indate='d:/web/graf/date'    !!! Tamara !!!!!!!	 
C--	open(10,file=indate)							 
C--	read(10,799) YEAR,AMN_cur,DD2,YEAR_pre,AMN_pre,ADY_pre,lda,lda_pre  !FORMAT NUMBER = 799
C--	WRITE(*,798) YEAR,AMN_cur,DD2,YEAR_pre,AMN_pre,ADY_pre,lda,lda_pre !FORMAT NUMBER = 798
C--	close(unit=10)
C--  798	format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3))
C--  799	format(A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3))	
C--        read(AMN_cur,*) rmn_cur
C--	imn_cur=int(rmn_cur)
C--        read(DD2,*) rdy_cur
C--	idy_cur=int(rdy_cur)
C++++++++++++++++++++++++++++++++++++++++
C
	 write(*,*) ' Enter <a> or <b>:'
	read(*,*) ab
C      infile='d:\web\dwf\YY\MM\wfMMDDUT.jYY'   ! current mn
      infile='d:\web\graf\dwc\YY\MM\ut\wxMMDDUT.jYY'   ! current mn
	infile(27:27)=ab ! <a> or <b>
C	outfilen='wfnYR.txt'   ! Cnt(Wf-) 
C	outfilep='wfpYR.txt'   ! Cnt(Wf+) 
C	outfiler='wfrYR.txt'
      outfile='d:\web\graf\datw\wulYYx3.txt'   !  Cnt(W-) 	 WL x = <a> or <b>
	outfile(23:23)=ab	!<a> or <b>
c-	do iut=0,7
c-	iut3=iut*3
c-	call blet2(iut3,aut)
c-	autout(iut)=aut
c-	enddo
   17 format(A2)
c-   31 FORMAT('YYMMDD',1X,3(8(2X,A2,1X)))
   32 FORMAT(73(1X,I4))
C
	WRITE(*,*)' ENTER YR OF INPUT FILE=	'
	read(*,17) AYR
	read(AYR,*) ryr
	IYR=int(ryr)   ! current yr
	if (iyr.lt.90) then
	iyyyy=2000+iyr
	              else
	iyyyy=1900+iyr
	endif
	z1=iyyyy/4.0
      jz=int(z1)*4

      IF(jz.EQ.iyyyy) THEN
               IM(2)=29
	dnr=366.
        ELSE
                IM(2)=28
	  	dnr=365.
	       ENDIF
	infile(17:18)=ayr
	infile(36:37)=ayr
	outfile(21:22)=ayr
C
  330	OPEN(11,file=outfile,access='APPEND')
C
      WRITE(*,*)' ENTER AMN OF INPUT FILE=	'
	read(*,17) AMN
	read(AMN,*) rmn
	if (rmn.eq.0) STOP
	IMN=int(rmn)   ! current mn

C
c--      imn2=12
c--	if (iyr.eq.20) imn2=imn_cur  ! TEMP
c--      DO 51 imn=1,imn2
	call blet2(imn,amn)
	infile(20:21)=amn
	infile(28:29)=amn
	mndy=im(imn)
C
      WRITE(*,*)' ENTER IDY1, IDY2=	'
	read(*,*) idy1,idy2
C  Day-to-day cycle
C
c--	if ((iyr.eq.20).and.(imn.eq.imn_cur)) mndy=idy_cur  ! TEMP
c--      DO 52 idy=1,mndy
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      DO 52 idy=idy1,idy2
	call blet2(idy,ADY)
	infile(30:31)=ady
C
c-	IF ((AMN.eq.'01').and.(ADY.eq.'01')) THEN
c-	write(*,31) (autout(k),k=0,23)
c-	write(11,31) (autout(k),k=0,23)
c-	write(12,31) (autout(k),k=0,23)
c-	write(13,31) (autout(k),k=0,23)
c-	ENDIF
C  UT cycle
C
      DO k=0,7
	wneg(k)=0.
	wpos(k)=0.
	wran(k)=0.
	ENDDO
	 wdyp=0.
	wdyn=0.
	wdyr=0.
	DO 53 iut=0,7
	iut1=iut*3
C
	sumn=0.		 ! count of Wf <-1
	sump=0.		 ! count of Wf >+1
	icntp=0
	swegp=0.
      icntn=0
	swegn=0.
C
C 3h UT period:
C
	DO 153 iut3=iut1,iut1+2
	call blet2(iut3,AUT)
c-      infile(24:25)=aut
	call blet2(iut3,AUT)
      infile(32:33)=aut
C
   	OPEN(10,file=infile,action='READ')
C
C/ cycle for lats:
       glat=-90.0	                  ! AD
	  do 54 ilat=1,71
	glat=glat+2.5				  ! AD
	elat=1.0+0.0001235*glat**2	  ! AD
	  read(10,32) (ivsr(k),k=0,72) 
C
	DO 333 ilon=0,72
          if (ivsr(ilon).gt.1) then
        iad=ivsr(ilon)
C	sump=sump+weg(iad)*ivsr(ilon)
	sump=sump+elat*weg(iad)*ivsr(ilon)  ! AD
	icntp=icntp+1
	swegp=swegp+weg(iad)
	goto 333
	endif
          if (ivsr(ilon).lt.-1) then
        iad=-ivsr(ilon)
C	sumn=sumn+weg(iad)*ivsr(ilon)
	sumn=sumn+elat*weg(iad)*ivsr(ilon)   ! AD
	icntn=icntn+1
	swegn=swegn+weg(iad)
	goto 333
	endif
  333	CONTINUE
   54 CONTINUE
	close(unit=10)
  153 CONTINUE
      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
      wneg(iut)=xneg
	wpos(iut)=xpos
	wran(iut)=xrange
C?	close(unit=10)
   53	CONTINUE           ! end UT cycle
       wpos(8)=wdyp/8.
	wneg(8)=wdyn/8.
	wran(8)=wdyr/8.
	do kk=0,7
	kut=kk*3
	write(*,33) AYR,AMN,ADY,kut,wpos(kk),wneg(kk),wran(kk)
	write(11,33) AYR,AMN,ADY,kut,wpos(kk),wneg(kk),wran(kk)
	enddo
   33 format(3A2,1X,I2,3(1X,F6.2))
   52 CONTINUE  ! daily cycle
   51 CONTINUE  ! Monthly cycle
      close(unit=11)
      if (iyr.ne.20) GOTO 330
      pause ' '
	STOP
	END
