subroutine subpianiaWmmc(YEAR,AMN,ADY)
C.........................................................Jun 2026
C WU, WL, WE indices from 1hr geogr code-W maps
C
C.........................................................Dec. 2020
C Include weight e(glat)
C
C.........................................................Nov. 2020
C Weighted PIA -pos ion activity, NIA - neg ion activity
C extracted from global Wc(TEC) index derived from JPL GIM-TEC (IONEX)
C for ADY_pre and forecast for DD2
C
	DIMENSION weg(4),IM(12),wneg(0:96),wpos(0:96),wran(0:96)
	CHARACTER*128 INFILE,OUTFILEN,OUTFILEP,OUTFILER  !global weighted Wfp,Wfn,Wfr = range index
C-	+,indate 
	CHARACTER*2 AYR,AUT,AMN,ADY,AMM
c-	CHARACTER*1 qs					  ! qs='c' CODE
	CHARACTER*4 YEAR,AUTOUT(0:95),AUTMM
	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='f:/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
	nn=0
	do iut=0,23
	call blet2(iut,aut)
	AUTMM(1:2)=AUT
	do mm=0,45,15
	call blet2(mm,amm)
	AUTMM(3:4)=AMM
	autout(nn)=AUTMM
	nn=nn+1
	enddo
	enddo
      AYR=YEAR(3:4)  ! for current day  	
        read(AMN,*) rmn
	imn=int(rmn)
        read(ADY,*) rdy
	  	idy=int(rdy)
C
C--      infile='f:\web\graf\dwc\YY\MM\ut\wcMMDDUT.jYY'   ! current mn
C      infile='f:\web\dws\YY\MM\woMMDDUT.jYY'   ! current mn
C+      infile='f:\web\graf\dw2\YY\MM\ut\wcMMDDUTMM.rYY'   ! current mn
      infile='f:\web\graf\dw1\YY\MM\ut\wcMMDDUT.cYY'   ! current mn
C+++
c-      if (qs.eq.'u') then
c-	infile(15:15)='u'
c-	else
c-	infile(15:15)='a'
c-	endif
C	outfilen='wfnYR.txt'   ! Cnt(Wf-) 
C	outfilep='wfpYR.txt'   ! Cnt(Wf+) 
C	outfiler='wfrYR.txt'
      outfilen='f:\web\graf\datc\wlnYYmc.txt'   !  Cnt(W-) 	 WL
      outfilep='f:\web\graf\datc\wupYYmc.txt'   !  Cnt(W+) 	 WU
      outfiler='f:\web\graf\datc\werYYmc.txt'   !  Cnt(Wrange) WE
c+      if (qs.eq.'r') then
c+	outfilen(16:16)='r'
c+	outfilep(16:16)='r'
c+	outfiler(16:16)='r'
c+	outfilen(24:24)='r'
c+	outfilep(24:24)='r'
c+	outfiler(24:24)='r'
c+	else
c+	outfilen(16:16)='a'
c+	outfilep(16:16)='a'
c+	outfiler(16:16)='a'
c+	outfilen(24:24)='a'
c+	outfilep(24:24)='a'
c+	outfiler(24:24)='a'
c+	endif
	nn=0
	do iut=0,23
	call blet2(iut,aut)
	autmm(1:2)=aut
	do mm=0,45,15
	call blet2(mm,amm)
	autmm(3:4)=amm
	autout(nn)=autmm
	nn=nn+1
	enddo
	enddo
C
   17 format(A2)
   31 FORMAT('YYMMDD',1X,96(1X,A4),2X,'DAY')
   32 FORMAT(73(1X,I4))
C
  330	CONTINUE
C      WRITE(*,*)' ENTER YR OF INPUT FILE=	'
C	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
C
        lda=ndoy(iyr,imn,idy)
	infile(17:18)=ayr
c+	infile(38:39)=ayr
	infile(36:37)=ayr
	outfilep(21:22)=ayr
	outfilen(21:22)=ayr
	outfiler(21:22)=ayr
C
	OPEN(11,file=outfilep,access='APPEND')
c+	OPEN(12,file=outfilen,access='APPEND')
c+	OPEN(13,file=outfiler,access='APPEND')

C
C month
C
	infile(20:21)=amn
	infile(28:29)=amn
	mndy=im(imn)
C
C  Day
C
	infile(30:31)=ady
C
c	IF ((AMN.eq.'01').and.(ADY.eq.'01')) THEN
c	write(*,31) (autout(k),k=0,95)
c	write(11,31) (autout(k),k=0,95)
c	write(12,31) (autout(k),k=0,95)
c	write(13,31) (autout(k),k=0,95)
c	ENDIF
C  UT cycle
C
      DO k=0,96
	wneg(k)=0.0
	wpos(k)=0.0
	wran(k)=0.0
	ENDDO
	 wdyp=0.
	wdyn=0.
	wdyr=0.
	nn=0
C
	DO 53 iut=0,23
	call blet2(iut,AUT)
      infile(32:33)=aut
C
C Minute cycle
C
c+	DO 200 imm=0,40,20
c+	call blet2(imm,AMM)
c+	infile(34:35)=amm
C
   	OPEN(10,file=infile,action='READ')
	sumn=0.		 ! count of Wf >=1
	sump=0.		 ! count of Wf <=-1
	icntp=0
	swegp=0.
      icntn=0
	swegn=0.
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,end=153) (ivsr(k),k=0,72) 
C
	DO 333 ilon=0,72
          if (ivsr(ilon).gt.1) then
        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)
	sumn=sumn+elat*weg(iad)*ivsr(ilon)   ! AD
	icntn=icntn+1
	swegn=swegn+weg(iad)
	goto 333
	endif
  333	CONTINUE
   54 CONTINUE
  153    xpos=0.
      if (icntp.gt.0.) then
		xpos=sump/icntp		 ! /cnt(Wf+)
	endif
      xneg=0.
      if (icntn.gt.0.) then
			xneg=sumn/icntn	  ! /cnt(Wf-)
	endif
	xrange=xpos-xneg
	wdyp=wdyp+xpos
	wdyn=wdyn+xneg
      wdyr=wdyr+xrange
      wneg(nn)=xneg
	wpos(nn)=xpos
	wran(nn)=xrange
	nn=nn+1
	close(unit=10)
  200	CONTINUE           ! end 15min cycle
   53	CONTINUE           ! end UT cycle
       wpos(96)=nint(wdyp/24)
	wneg(96)=nint(wdyn/24)
	wran(96)=nint(wdyr/24)
CC
	kk=-1
	kmm=0
	DO kut=0,23
C	
c+	do kmm=0,40,20
	kk=kk+1
	write(*,33) AYR,AMN,ADY,lda,kut,kmm,wpos(kk)
	write(11,33) AYR,AMN,ADY,lda,kut,kmm,wpos(kk)
C+	write(*,33) AYR,AMN,ADY,(iwpos(k),k=0,96)
c+	write(11,33) AYR,AMN,ADY,(iwpos(k),k=0,96)
ctemp	write(*,33) AYR,AMN,ADY,lda,kut,kmm,wneg(kk)
ctemp	write(11,33) AYR,AMN,ADY,lda,kut,kmm,wneg(kk)
C+	write(*,33) AYR,AMN,ADY,(iwneg(k),k=0,96)
C+	write(12,33) AYR,AMN,ADY,(iwneg(k),k=0,96)
ctemp	write(*,33) AYR,AMN,ADY,lda,kut,kmm,wran(kk)
ctemp	write(11,33) AYR,AMN,ADY,lda,kut,kmm,wran(kk)
C+	write(*,33) AYR,AMN,ADY,(iwran(k),k=0,96)
C+	write(13,33) AYR,AMN,ADY,(iwran(k),k=0,96)
c+        enddo
	ENDDO
c+   33 format(3A2,96(1X,I4),2X,I4)
   33 format(3A2,1X,I3,2(1X,I2),1X,F4.1)
   52 CONTINUE  ! daily cycle
   51 CONTINUE  ! Monthly cycle
      close(unit=11)
c+	close(unit=12)
c+	close(unit=13)
C-      if (iyr.ne.20) GOTO 330
C      pause ' '
	RETURN
C	STOP
	END