	subroutine subwp3mc(AYR,AMN,IDY1,IDY2)
C.....................................................Dec 2023
C
C.....................................................Nov. 2012
C JPL results
C.....................................................Oct.2012
C Update monthly Wp, Np, Pp files
C
C.....................................................Apr. 2012
C
C IONEX maps
C for glat=-87.5:2.5:87.5, glong=-180:5:165  (5112 => 840 grids)
C Correction of (W+max-W-max)*(1+cntstrm/5112)
C.....................................................Feb. 2012
C
C.....................................................Aug.2011
C
C Input: maps of W-index: tcMNDYUT.wYR files 
C             for glat=-85:5:85, glong=-180:15:165  (=840 grids)
C Correction of (W+max-W-max)*(1+cntstrm/840)
C
C........................................................Apr.2008
C...... Count RANGE only when W+=>3, and/or W-<=-3 ..............
C
c........................................................Oct.2007
C Correction of (W+max-W-max)*(1+cntstrm/600)
C cntstrm=total number of W+=3,W+=4, W-=-3,W-=-4 for the IONEX-map
C
c .......................................................Sep. 2007
C Range of TEC indices from 35 latitude results TEC.fYR.........
C
c from hourly IONEX maps
c
ct	DIMENSION RESP(366,0:23),RESN(366,0:23),DHR(0:23)
c<<	DIMENSION RESP(0:23),RESN(0:23),DHR(0:23),IM(12)
	DIMENSION RESP(0:71),RESN(0:71),DHR(0:71),IM(12)
ct	+,XPH(0:23),XNH(0:23),cnts(366,3,0:23),xind(366,3,0:23,0:35)
c<<	+,cnts(35,3,0:23),xind(35,3,0:23)
	+,cnts(71,3,0:23),xind(71,3,0:23)
C cnts(1,12)=cntsrm, cnts(2,12)=cntsrmn,cnts(3,12)=cntsrmp for 12 UT
C 
ct     +,RES(366,0:23),RUP(35,366,0:23),RLO(35,366,0:23)
c<<     +,RES(0:23),RUP(0:23),RLO(0:23)
     +,RES(0:71),RUP(0:71),RLO(0:71)
ct	+,clat(366,3,0:23,0:35),relat(366,3,0:23,0:35)
c<<	+,clat(35,3,0:23),relat(35,3,0:23)
	+,clat(71,3,0:23),relat(71,3,0:23)
	 INTEGER*2 IYR,MN,IDY,idy1,idy2,iut
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	CHARACTER*64,infile,outfile,outfilep,outfilen,outinfo,title
	CHARACTER*135 wpast(0:365),wwpos(0:365),wwneg(0:365),txt
	CHARACTER*2 AYR,AMN,AUT,ADY
	+,aa(24),bb
	CHARACTER*6 YRMNDY
	CHARACTER*4 AYEAR,AMEAN
      DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C Controlling Selected Latitudes 1=Yes, 0 = No:
	DATA aa/'00','01','02','03','04','05','06','07','08','09','10'
	+,'11','12','13','14','15','16','17','18','19','20','21','22','23'/
	bb='UT'
	amean='mean'
	title='YYMMDD UT CNTNEG CNTPOS CNTTOT   TOT%    Wp'
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT

C start
crem      WRITE(*,'(\A\)') ' ENTER YEAR OF INPUT FILE='
crem      READ(*,'(A)') AYEAR
	AYEAR(1:2)='20'
	AYEAR(3:4)=ayr
c///	ayr=ayear(3:4)
	read(ayr,*) year
	iyr=int(year)

crem      WRITE(*,'(\A\)') ' ENTER MONTH OF INPUT FILE='
crem      READ(*,'(A)') AMN
c///	AMN=DD(5:6)
	read(amn,*) rmn
	mn=int(rmn)
	if(int(year/4.)*4.eq.iyr) THEN 
	ndnr=366
	im(2)=29
	                          ELSE
	ndnr=365
	im(2)=28
	ENDIF

crem      WRITE(*,'(\A\)') ' ENTER DY1 & DY2 ='
crem      READ(*,13) idy1,idy2
 13   FORMAT(I2)

CC CALCULATION OF DAYS OF YEAR	
C?      infile='c:\web\dws\YR\MN\woMNDYUT.jYR' ! W(mlat & mlong map)
      infile='c:\web\dws\YR\MN\wiMNDYUT.jYR' ! W(mlat & mlong map)
  	infile(12:13)=ayr
	infile(15:16)=amn
  	infile(28:29)=ayr
	infile(20:21)=amn
C      outfile='wjtecYR.txt'	! W-indices from W-maps geogr.coord.
	outfile='c:\web\grif\datw\wptemYR.txt'	! W-indices from W-maps magn.coord.
	outfile(23:24)=AYR
 	outfilep=outfile
	outfilen=outfile
	outfilep(18:18)='p'
	outfilen(18:18)='n'
	outinfo='wminfoYR.txt'
	outinfo(7:8)=ayr
	OPEN(110,FILE=OUTINFO,ACCESS='APPEND')
	write(110,14) title
   14	format(1X,A43)
C
  	OPEN(112,FILE=OUTFILE,ACCESS='APPEND')
	OPEN(113,FILE=OUTFILEP,ACCESS='APPEND')
	OPEN(114,FILE=OUTFILEN,ACCESS='APPEND')
 198	format(4X,A2,24(3X,A2),3X,A4)
C
	lda1=ndoy(iyr,mn,idy1)  ! day-of-year
	mndy=im(mn)
  130	format(A135)

C
C read-re-write outfile for days from 1 to lda1-1:
        if (lda1.eq.1) GOTO 123
	ncnt=0
	do 149 ipast=0,lda1-1
	read(112,130,END=151,ERR=2) txt
	wpast(ipast)=txt
	YRMNDY=txt(1:6)
  151	read(113,130,END=152,ERR=2) txt
 	wwpos(ipast)=txt
  152	read(114,130,END=153,ERR=2) txt
 	wwneg(ipast)=txt
	if (yrmndy.eq.'      ') goto 149
	ncnt=ncnt+1
  149	continue
  153 close(unit=112)
      close(unit=113)
	close(unit=114)
C
  	OPEN(112,FILE=OUTFILE)
	OPEN(113,FILE=OUTFILEP)
	OPEN(114,FILE=OUTFILEN)
C re-write past data:
	do ipast=0,ncnt-1
	write(112,130) wpast(ipast)
cc	write(*,130) wpast(ipast)  ! test
	write(113,130) wwpos(ipast)
	write(114,130) wwneg(ipast)
	enddo
      close(unit=112)
      close(unit=113)
	close(unit=114)
CC  
  197 continue
  	OPEN(112,FILE=OUTFILE,ACCESS='APPEND')
	OPEN(113,FILE=OUTFILEP,ACCESS='APPEND')
	OPEN(114,FILE=OUTFILEN,ACCESS='APPEND')

C
123	if((mn.eq.1).and.(idy1.eq.1)) then 

	write(112,198) bb,aa,amean
	write(113,198) bb,aa,amean
	 write(114,198) bb,aa,amean
      write(*,198) bb,aa,amean
C	goto 197 ! avoid read-re-write
	endif
C  day-to-day cycle
C ========================================

       DO 500 idy=idy1,idy2
	lda=ndoy(iyr,mn,idy)  ! day-of-year
	call blet2(idy,ady)
	infile(22:23)=ady
C
C	cnts(35,3,0:23),xind(35,3,0:23)

	do i=0,23		 ! ut=0,1,...,23
	do k=1,3
	do n=1,71
	cnts(n,k,i)=0.
	xind(n,k,i)=0.
	clat(n,k,i)=0.        !clat(71,3,0:23)
 	relat(n,k,i)=0.
 	enddo
	enddo
	enddo
C UT ??????????????????
      do k=0,23
	res(k)=0.
	rup(k)=0.
	rlo(k)=0.
	resp(k)=0.
	resn(k)=0.
	enddo
C
 	sum=0.
	sumn=0.
	sump=0.

C cycle on UT:
C -----------------------------------------------------
      DO 801 iut=0,23		! cycle on UT
	call blet2(iut,aut)
	infile(24:25)=aut
	OPEN(111,FILE=INFILE)
c
	cnttot=0.       !!!new for W-map
	cntneg=0.       !!!new for W-map
	cntpos=0.       !!!new for W-map
C ===== Input datafile 
 1311	DO 1799 jj=1,71	  ! glats= -87.5:2.5:87.5
c	pause ' '
    1	READ (111,12,END=3,ERR=2) (DHR(k),k=0,71) ! W(longs=-180:5:175)
  12	FORMAT(72(1X,F4.0))
C
	DO k=0,71				! Cycle on Longi	 <<<<<<<<
c==	if (dhr(k).gt.90.) dhr(k)=0.
C++ Count stormy indices W-:
	if (dhr(k).lt.-2) then 
	dcnt=1.					  ! weight=1 for ind=-3, -4
	cnts(jj,2,iut)=cnts(jj,2,iut)+dcnt	 !cnt(Wneg<-2) at lat jj
	cnts(jj,1,iut)=cnts(jj,1,iut)+dcnt	 !cnt(Wstr) at lat jj
C Counts at each Lati (divided by 72 glongs):
	clat(jj,2,iut)=clat(jj,2,iut)+dcnt/72. !glat,Ind,UT_iut
c!!!	cntneg=clat(jj,2,iut)
      cntneg=cntneg+1.  !!!new for W map
	clat(jj,1,iut)=clat(jj,1,iut)+dcnt/72.    ! Range
c!!!	cnttot=clat(jj,1,iut)
	cnttot=cnttot+1.  !!!new for W map
	 endif
C++	Count stormy indices W+:
		if (dhr(k).gt.2) then 
	dcnt=1.					  ! weight=1 for ind=+3, +4
 	cnts(jj,3,iut)=cnts(jj,3,iut)+dcnt	!cnt(Wpos>2) at lat jj
	cnts(jj,1,iut)=cnts(jj,1,iut)+dcnt	!cnt(Wstr) at lat jj
C Counts at each Lati:
		clat(jj,1,iut)=clat(jj,1,iut)+dcnt/72. ! Range
c!!!	cnttot=clat(jj,1,iut)
      cnttot=cnttot+1.  !!!new for W map
 	clat(jj,3,iut)=clat(jj,3,iut)+dcnt/72.	  ! W+
c!!!	cntpos=clat(jj,1,iut)
	cntpos=cntpos+1.  !!!new for W map
	 endif

C MAX index at 71 lati:
	if (rup(iut).lt.dhr(k)) rup(iut)=dhr(k)	! at current lat
	if (xind(jj,3,iut).lt.dhr(k)) xind(jj,3,iut)=dhr(k) !at lat=jj
	
C MIN index at 71 lati:
	if (rlo(iut).gt.dhr(k)) rlo(iut)=dhr(k) ! at current lat
	if (xind(jj,2,iut).gt.dhr(k)) xind(jj,2,iut)=dhr(k)	!at lat=jj
	enddo		    ! Cycle on Longi	 >>>>>>>>>>>>>
C   Range for given Lati, UT:
	amin=0.	 ! W<0.
	bmax=0.		!W>0.
	do k=0,71				   ! longs
	if ((dhr(k).lt.0.).and.(amin.gt.dhr(k))) amin=dhr(k) ! at lat=jj
	if ((dhr(k).gt.0.).and.(bmax.lt.dhr(k))) bmax=dhr(k) ! at lat=jj
	enddo

cc	wpos=bmax*(1.+clat(jj,3,iut)/35.) ! 	W+	/35?????????????
	wpos=bmax                            ! at lat=jj
	relat(jj,3,iut)=wpos	!W+			 ! at lat=jj
cc	wneg=amin*(1.+clat(jj,2,iut)/35.) !     W-	/35?????????????
      wneg=amin							 ! at lat=jj
	relat(jj,2,iut)=wneg    !W-			 ! at lat=jj
	if (clat(jj,1,iut).gt.0.) then
ctemp	wrange=(bmax-amin)*(1.+clat(jj,1,iut)) !  Range
cc	wrange=(bmax-amin)*(1.+clat(jj,1,iut)/35.) !  Range	/35?????????????
c!!!	wrange=(bmax-amin)*(1.+clat(jj,1,iut)/10.) !  Range	
      wrange=(bmax-amin)             		   ! at lat=jj
	                          else
	wrange=amax1(bmax,abs(amin))		   ! at lat=jj
	                          endif
	relat(jj,1,iut)=wrange  ! W Range	   ! at lat=jj

 1799	CONTINUE				   ! Cycle jj on glats (total W map)
  3   CLOSE(unit=111)

C----------------------------------------------------------
C average for 71 Lati => Basic Wp for each ut
C
		cneg=0.
 	cpos=0.
	ctot=0.
	 dneg=0.
	dpos=0.
	dtot=0.
	lat1=1    !cnew
	lat2=71	  !cnew
	alats=71.  !cnew				   ! 71 glati -87.5:2.5:87.5
cold	lat1=6      !cold
cold	lat2=30		!cold
cold	alats=25.	!cold			   ! 25 glati -60:5:60
c<<	grids=alats*24.          ! alats*24 hrs UT
      	grids=alats*72.          ! alats*glongs (=0:71 glongs)?????????????/
	do kk=lat1,lat2				   ! 
	dneg=dneg+relat(kk,2,iut)
	dpos=dpos+relat(kk,3,iut)
      dtot=dtot+relat(kk,1,iut)
	ctot=ctot+cnts(kk,1,iut)
	cneg=cneg+cnts(kk,2,iut)
	cpos=cpos+cnts(kk,3,iut)
C ++++++++++++
	enddo					   !  glati
	res(iut)=(1.+ctot/grids)*dtot/alats
	resn(iut)=(1.+cneg/grids)*dneg/alats
	resp(iut)=(1.+cpos/grids)*dpos/alats
	if (res(iut).ge.5.0) then
	totper=ctot/grids*100.
	write(*,73) AYR,AMN,ADY,iut,cneg,cpos,ctot,totper,res(iut)
	write(110,73) AYR,AMN,ADY,iut,cneg,cpos,ctot,totper,res(iut)
	endif
c   
  801 continue            ! end cycle on UT 
  73	format(1X,3A2,1X,I2,3(2X,F5.0),2(2X,F5.1))

C  Daily mean:
C
	sum=0.
	sump=0.
	sumn=0.
		do m=0,23      ! cycle on UT		======
 175	sum=sum+res(m)
	sump=sump+resp(m)
	sumn=sumn+resn(m)
	enddo							 !=========
ct	sum=sum/12.
	sum=sum/24.
	sump=sump/24.
	sumn=sumn/24.
	yrmndy='000000'
	yrmndy(1:2)=AYR
	yrmndy(3:4)=AMN
	yrmndy(5:6)=ADY	
	write(112,72) yrmndy,(res(k),k=0,23),sum
		write(113,72) yrmndy,(resp(k),k=0,23),sump
		write(114,72) yrmndy,(resn(k),k=0,23),sumn
	write(*,72) yrmndy,(res(k),k=0,23),sum
 	write(*,72) yrmndy,(resp(k),k=0,23),sump
 	write(*,72) yrmndy,(resn(k),k=0,23),sumn
C
  500	CONTINUE ! next day
C
   72 format(A6,24(1X,F4.1),1X,F7.2)
ct   75 continue	 	  ! <<<<<<<<<<<<<<<<<<
	CLOSE(unit=110)
	CLOSE(unit=112)
	CLOSE(unit=113)
	CLOSE(unit=114)
	goto 900
    2 CONTINUE
           write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
  900 continue
c      pause ' '
	RETURN
crem      STOP
      END

