      subroutine subpnwmm(YEAR,AMN,ADY)
C.........................................................Aug 2022
C Ip and In indices from 15min geogr UQRG-W maps
C
	DIMENSION IM(12),inw(0:96),ipw(0:96),ivsr(0:72)
	CHARACTER*128 INFILE,OUTFILEP,OUTFILEN  !global Intensity of W=3,4/W=-3,-4
	CHARACTER*2 AYR,AUT,AMN,ADY,AMM
	CHARACTER*4 YEAR,AUTOUT(0:95),AUTMM
            DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
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
      infile='d:\web\graf\dwu\YY\MM\ut\wcMMDDUTMM.uYY'   ! current mn
C+++
      outfilep='d:\web\graf\datu\apwYYmm.txt'   !  
	outfilen='d:\web\graf\datu\anwYYmm.txt'   !  
	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
	infile(17:18)=ayr
	infile(38:39)=ayr
	outfilep(21:22)=ayr
	outfilen(21:22)=ayr
C
	OPEN(11,file=outfilep,access='APPEND')
	OPEN(12,file=outfilen,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
	IF ((AMN.eq.'01').and.(ADY.eq.'01')) THEN
	write(*,31) (autout(k),k=0,95)
	write(11,31) (autout(k),k=0,95)
	write(12,31) (autout(k),k=0,95)
	ENDIF
C  UT cycle
C
      DO k=0,96
	inw(k)=0
	ipw(k)=0
	ENDDO
C
	nn=0  !collect daily results
C
	DO 53 iut=0,23         !UTTTTTTTTTTTTTTT
	call blet2(iut,AUT)
      infile(32:33)=aut
C
C Minute cycle
C
	DO 200 imm=0,45,15                !++++++++++++
	call blet2(imm,AMM)
	infile(34:35)=amm
C
   	OPEN(10,file=infile,action='READ')
	sumn=0.		 ! count of Wf >=0
	sump=0.		 ! count of Wf <0
	icntp=0
      icntn=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).ge.2) then
	icntp=icntp+1
	goto 333
	endif
          if (ivsr(ilon).le.-2) then
	icntn=icntn+1
	goto 333
	endif
  333	CONTINUE
   54 CONTINUE
  153 close(unit=10)
        xpw=icntp/5183.
	ipw(nn)=nint(xpw*100.)
	xnw=icntn/5183.
      inw(nn)=nint(xnw*100.)
c       sump=sump+xpw
c	sumn=sumn+xnw
	nn=nn+1
  200	CONTINUE           ! end 15min cycle
      cp=0.
	cn=0.
      do k=0,95
	cp=cp+ipw(k)
	cn=cn+inw(k)
	enddo
	ipw(96)=nint(cp/96.)
	inw(96)=nint(cn/96.)
      
   53	CONTINUE           ! end UT cycle
	write(*,33) AYR,AMN,ADY,(ipw(k),k=0,96)
	write(11,33) AYR,AMN,ADY,(ipw(k),k=0,96)
	write(*,33) AYR,AMN,ADY,(inw(k),k=0,96)
	write(12,33) AYR,AMN,ADY,(inw(k),k=0,96)
   33 format(3A2,96(1X,I4),2X,I4)
	
c   52 CONTINUE  ! daily cycle
      close(unit=11)
	close(unit=12)
C
c   51 CONTINUE  ! Monthly cycle
C      pause ' '
	RETURN
C	STOP
	END
