      subroutine subnetvolc(YEAR,AMN,ADY,xlat)
C.........................................................Jan 2024
C
C Input wiMNDDUT.jYR from f:/web/
C output: c:/web/grif/datw/
C.........................................................Nov. 2021
C Global NVU, NVL, NVE from Wo maps in magn. coords.
C if xlat=0.0 output global results
C if xlat=60.0 output Arctic results for MLAT >=60 deg
C if xlat=-60.0 output Antarctic results for MLAT <=-60 deg
C
C  -pos ion activity, - neg ion activity
C extracted from global Wc(TEC) index derived from JPL GIM-TEC (IONEX)
C for ADY
C
	DIMENSION IM(12),iwnet(0:24)
	CHARACTER*128 INFILE,OUTFILE  !global Net Volume
	CHARACTER*2 AYR,AUT,AMN,ADY,AUTOUT(0:23)
	CHARACTER*4 YEAR
	INTEGER ivsr(0:72) !  set of Wf indices for long=-10:5:180 at given lati
            DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
C
C
      AYR=YEAR(3:4)  ! for current day  	
        read(AMN,*) rmn
	imn=int(rmn)
        read(ADY,*) rdy
	  	idy=int(rdy)
C
C--      infile='c:\web\graf\dwc\YY\MM\ut\wcMMDDUT.jYY'   ! current mn
CPRE      infile='c:\web\dws\YY\MM\woMMDDUT.jYY'   ! current mn
      infile='f:\web\dws\YY\MM\wiMMDDUT.jYY'   ! current mn -15d
      outfile='c:\web\grif\datw\nviYYm.txt'   !  Net Volume	-15d mag
      if (xlat.lt.-59.) then
	outfile(23:23)='s'
	endif
      if (xlat.gt.59.) then
	outfile(23:23)='n'
	endif
	do iut=0,23
	call blet2(iut,aut)
	autout(iut)=aut
	enddo
   17 format(A2)
   31 FORMAT('YYMMDD',1X,24(2X,A2,1X),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(12:13)=ayr
	infile(28:29)=ayr
	outfile(21:22)=ayr
C
	OPEN(13,file=outfile,access='APPEND')

C
C month
C
	infile(15:16)=amn
	infile(20:21)=amn
	mndy=im(imn)
C
C  Day
C
	infile(22:23)=ady
C
	IF ((AMN.eq.'01').and.(ADY.eq.'01')) THEN
	write(*,31) (autout(k),k=0,23)
	write(13,31) (autout(k),k=0,23)
	ENDIF
C  UT cycle
C
      DO k=0,24
	iwnet(k)=0
	ENDDO
	 wdyp=0.
	wdyn=0.
	wdyr=0.
	DO 53 iut=0,23
	call blet2(iut,AUT)
      infile(24:25)=aut
C
   	OPEN(10,file=infile,action='READ')
	sumn=0.		 ! count of Wf >=1
	sump=0.		 ! count of Wf <=-1
	     icnt=0
	icn=0  !North
	ics=0  !South
C
C/ cycle for lats:
       glat=-90.0	                  ! AD
	  do 54 ilat=1,71
	glat=glat+2.5				  ! AD
	  read(10,32) (ivsr(k),k=0,72) 
C
	IF (xlat.eq.0.) goto 122
C 
     	IF (xlat.lt.-60.) THEN		! -62.5, -65,...-87.5
		if(glat.lt.-60.) then
	ics=ics+73
      	goto 123
 	                       else
      	goto 54
	                       endif
     	                 ENDIF
C
      IF(xlat.gt.60.) THEN		 !62.5, 65, ..., 87.5
	    if (glat.gt.60.) then
	icn=icn+73
	    goto 123
	                  else
	    goto 54
	                    endif
	                 ENDIF
C
  122 icnt=icnt+73  ! Total number of gids per network
  123	DO 333 ilon=0,72
          if (ivsr(ilon).gt.1) then
C-          if (ivsr(ilon).gt.2) then	  !+3, +4
        iad=ivsr(ilon)
	sump=sump+iad  ! AD
	goto 333
	endif
          if (ivsr(ilon).lt.-1) then
C-          if (ivsr(ilon).lt.-2) then	   !-3, -4
        iad=ivsr(ilon)
	sumn=sumn+iad   ! AD
	goto 333
	endif
  333	CONTINUE
   54 CONTINUE
C global
      IF (xlat.eq.0.) then
	xnet=(sump+sumn)/icnt  ! Net Volume
      wdyr=wdyr+xnet
	iwnet(iut)=nint(xnet*100.)
	GOTO 170
	             endif
CC
CC Arctic
  171  IF (xlat.lt.-60.) THEN
	xnet=(sump+sumn)/ics  ! Net Volume
      wdyr=wdyr+xnet
	iwnet(iut)=nint(xnet*100.)
	goto 170
	endif
CC Antarctic
      IF(xlat.gt.60.) THEN
	xnet=(sump+sumn)/icn  ! Net Volume
      wdyr=wdyr+xnet
	iwnet(iut)=nint(xnet*100.)
	endif
CC
  170	close(unit=10)
   53	CONTINUE           ! end UT cycle
	iwnet(24)=nint(wdyr/24.*100.)
c=	write(*,33) AYR,AMN,ADY,(iwnet(k),k=0,24)  !TEMP
	write(13,33) AYR,AMN,ADY,(iwnet(k),k=0,24)
   33 format(3A2,24(1X,I4),2X,I4)
   52 CONTINUE  ! daily cycle
   51 CONTINUE  ! Monthly cycle
	close(unit=13)
C      pause ' '
	RETURN
C	STOP
	END
