subroutine subwp6mc(ns,AYEAR) C.....................................................Apr 2025 C mag lat >= +- 62.5: +- 87.5 (wpi); +-40:+-60 (wpo); +-10:+-30 (wpe) 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,IMN,IDY,idy1,idy2,iut CHARACTER(10) DD CHARACTER(10) TT CHARACTER(5) ZZ CHARACTER*64,infile,outfile,title CHARACTER*2 AYR,AMN,AUT,ADY +,bb CHARACTER*1 ioe,ns 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: C- DATA aa/'00','01','02','03','04','05','06','07','08','09','10' C- +,'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+ ns='n' C+ ns='s' C start C C+ WRITE(*,'(\A\)') ' ENTER YEAR OF INPUT FILE=' C+ READ(*,'(A)') AYEAR C- AYEAR(1:2)='20' C- AYEAR(3:4)=ayr ayr=ayear(3:4) read(ayr,*) year iyr=int(year) C C outfile='wjtecYR.txt' ! W-indices from W-maps geogr.coord. outfile='c:\web\grif\datw\wpxYRz.txt' ! W-indices from W-maps magn.coord.x=i, o, e; z=n (North) or s (South) outfile(21:22)=AYR outfile(23:23)=ns C++++++++++++++++++ ioe='i' 100 CONTINUE C WRITE(*,'(\A\)') ' ENTER i, o, e for MLAT range' C READ(*,'(A)') ioe C outfile(20:20)=ioe OPEN(112,FILE=OUTFILE) C if (ioe.eq.'i') then glat1=62.5 glat2=87.5 lat1=61 !cnew lat2=71 !cnew alats=11. !cnew ! 71 glati -87.5:2.5:62.5 endif if (ioe.eq.'o') then glat1=40.0 glat2=60.0 lat1=52 !cnew lat2=60 !cnew alats=9. !cnew ! 71 glati -60.0:2.5:40.0 endif if (ioe.eq.'e') then glat1=10.0 glat2=30.0 lat1=40 !cnew lat2=48 !cnew alats=9. !cnew ! 71 glati -87.5:2.5:87.5 endif IF (ns.eq.'s') THEN glat=glat2*(-1.0) glat2=glat1*(-1.0) glat1=glat lat=72-lat2 lat2=72-lat1 lat1=lat ENDIF crem WRITE(*,'(\A\)') ' ENTER MONTH OF INPUT FILE=' crem READ(*,'(A)') AMN c/// AMN=DD(5:6) C? read(amn,*) rmn C? 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) C infile='c:\web\dws\YR\MN\wiMNDYUT.jYR' ! W(mlat & mlong map) infile='f:\web\dws\YR\MN\wiMNDYUT.jYR' ! W(mlat & mlong map) infile(12:13)=ayr infile(28:29)=ayr C Cycle on MN ++++++++++++++++++++++++++++++++++ imnend=12 if (iyr.eq.25) imnend=3 !TEMPPPPPPPPPPPPPP C DO 101 imn=1,imnend call blet2(imn,AMN) infile(15:16)=amn infile(20:21)=amn 14 format(1X,A43) C 198 format(4X,A2,24(3X,A2),3X,A4) C idy1=1 idy2=im(imn) mndy=im(imn) C 130 format(A135) C C C day-to-day cycle C ======================================== DO 500 idy=idy1,idy2 lda=ndoy(iyr,imn,idy) ! day-of-year call blet2(idy,ady) infile(22:23)=ady C 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,action='READ') c cnttot=0. !!!new for W-map C ===== Input datafile xlat=-90.0 1311 DO 1799 jj=1,71 ! glats= -87.5:2.5:87.5 c pause ' ' xlat=xlat+2.5 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 IF ((xlat.lt.glat1).or.(xlat.gt.glat2)) GOTO 1799 C Zonal Wp: 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. c- lat1=1 !cnew c- lat2=71 !cnew C// 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)?????????????/ C 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 C resn(iut)=(1.+cneg/grids)*dneg/alats C 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) C// 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(*,72) yrmndy,(res(k),k=0,23),sum write(112,72) yrmndy,(res(k),k=0,23),sum c- write(113,72) yrmndy,(resp(k),k=0,23),sump c- write(114,72) yrmndy,(resn(k),k=0,23),sumn c- write(*,72) yrmndy,(resp(k),k=0,23),sump c- write(*,72) yrmndy,(resn(k),k=0,23),sumn C 500 CONTINUE ! next day C 101 CONTINUE ! next mn 72 format(A6,24(1X,F4.1),1X,F7.2) ct 75 continue ! <<<<<<<<<<<<<<<<<< C- CLOSE(unit=110) CLOSE(unit=112) c- CLOSE(unit=113) c- CLOSE(unit=114) if (ioe.eq.'e') goto 900 if (ioe.eq.'i') then ioe='o' goto 100 endif if (ioe.eq.'o') then ioe='e' goto 100 endif C GOTO 900 2 CONTINUE write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 900 continue c pause ' ' RETURN crem STOP END