subroutine subwp3uf(ua,AYR,AMN,IDY,iut_fin,imm_fin) C.....................................................May 2026 C C uqrg & uadg Wp results C C Update monthly Wpu ~Wpa, files C C C IONEX maps C for glat=-87.5:2.5:87.5, glong=-180:5:180 (5183) C Correction of (W+max-W-max)*(1+cntstrm/5183) C.....................................................Feb. 2012 C C.....................................................Aug.2011 C C........................................................Apr.2008 C...... Count RANGE only when W+=>3, and/or W-<=-3 .............. C c........................................................Oct.2007 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 DIMENSION DHR(0:71),IM(12) +,cnts(71,3,0:23),xind(71,3,0:23) C +,RES(0:71),RUP(0:71),RLO(0:71) +,clat(71,3,0:23),relat(71,3,0:23) CHARACTER(10) DD CHARACTER(10) TT CHARACTER(5) ZZ CHARACTER*64,infile,outfile CHARACTER*2 AYR,AMN,AUT,ADY,AMM,CYR,CMN,CDY CHARACTER*21 m_data CHARACTER*4 AYEAR CHARACTER*1 ua DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ C CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ) TT(5:)=' ' WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT C start Crem ua='u' ! uqrg C AYEAR(1:2)='20' AYEAR(3:4)=ayr read(ayr,*) year iyr=int(year) 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 C call blet2(idy,ADY) 13 FORMAT(I2) 333 FORMAT(A21) CC CALCULATION OF DAYS OF YEAR infile='f:\web\graf\dwu\YR\MN\ut\wcMNDYUTMM.uYR' !W(glat & glong map)!Tamara infile(15:15)=ua infile(17:18)=ayr !Tamara infile(20:21)=amn !Tamara infile(38:39)=ayr !Tamara infile(28:29)=amn !Tamara infile(30:31)=ady !Tamara C outfile='c:\web\graf\datw\wptecYR.txt' !W-index from W-maps geogr.coord.!Tamara outfile='f:\web\graf\dwu\wutecYRMN.txt' ! !Tamara outfile(15:15)=ua outfile(18:18)=ua outfile(22:23)=AYR !Tamara outfile(24:25)=AMN 14 format(1X,A43) C lda=ndoy(iyr,mn,idy) ! day-of-year mndy=im(mn) C................................ C read-re-write outfile for days from 1 to lda-1: icount=0 OPEN(12,FILE=outfile) 255 READ(12, 333, END=244) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.ady)) then goto 244 else icount=icount+1 GOTO 255 CONTINUE endif 244 k_strings = icount REWIND (12) icount=0 do while (icount.lt.k_strings) READ(12, 333, END=248) m_data icount=icount+1 enddo 248 print*,'YES!',outfile ENDFILE 12 close(UNIT=12) C 130 format(3A2,1X,I3,2(1X,I2),1X,F4.1) ! output C ncnt=k_strings CC OPEN(12,FILE=OUTFILE,ACCESS='APPEND') C C day-to-day cycle C ======================================== C-- DO 500 idy=idy1,idy2 C-- lda=ndoy(iyr,mn,idy) ! day-of-year C-- call blet2(idy,ady) C-- infile(30:31)=ady !Tamara C C cnts(71,3,0:23),xind(71,3,0:23) C do i=0,23 ! ut=0,1,...,23 do k=1,3 do n=1,71 cnts(n,k,i)=0. !???????????????????????????????CHECK xind(n,k,i)=0. clat(n,k,i)=0. !clat(71,3,0:23) relat(n,k,i)=0. enddo enddo enddo C C cycle on UT: CC ----------------------------------------------------- DO 801 iut=0,iut_fin ! cycle on UT call blet2(iut,aut) infile(32:33)=aut !Tamara C C sum=0. C immend=45 if (iut.eq.iut_fin) immend=imm_fin CC DO 802 imm=0,immend,15 call blet2(imm,amm) infile(34:35)=amm OPEN(11,FILE=INFILE) c cnttot=0. !!!new for W-map cntneg=0. !!!new for W-map cntpos=0. !!!new for W-map CC C ===== Input datafile CC 1311 DO 1799 jj=1,71 ! glats= -87.5:2.5:87.5 c pause ' ' 1 READ (11,12,END=3,ERR=2) (DHR(k),k=0,72) ! W(longs=-180:5:180) 12 FORMAT(73(1X,F4.0)) C DO k=0,72 ! 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/73. !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/73. ! 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/73. ! Range c!!! cnttot=clat(jj,1,iut) cnttot=cnttot+1. !!!new for W map clat(jj,3,iut)=clat(jj,3,iut)+dcnt/73. ! W+ c!!! cntpos=clat(jj,1,iut) cntpos=cntpos+1. !!!new for W map endif C MAX index at 71 lati: C- if (rup(iut).lt.dhr(k)) rup(iut)=dhr(k) ! at current lat C- if (xind(jj,3,iut).lt.dhr(k)) xind(jj,3,iut)=dhr(k) !at lat=jj C MIN index at 71 lati: C- if (rlo(iut).gt.dhr(k)) rlo(iut)=dhr(k) ! at current lat C- if (xind(jj,2,iut).gt.dhr(k)) xind(jj,2,iut)=dhr(k) !at lat=jj enddo ! Cycle on Longi >>>>>>>>>>>>> C C Range for given Lati, UT: C 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=11) CC 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 grids=alats*73. ! alats*glongs (=0:72 glongs) do kk=lat1,lat2 ! c- dneg=dneg+relat(kk,2,iut) c- dpos=dpos+relat(kk,3,iut) dtot=dtot+relat(kk,1,iut) ctot=ctot+cnts(kk,1,iut) c- cneg=cneg+cnts(kk,2,iut) c- cpos=cpos+cnts(kk,3,iut) enddo ! glati C ++++++++++++ res_iutimm=(1.+ctot/grids)*dtot/alats write(*,130) AYR,AMN,ADY,lda,iut,imm,res_iutimm write(12,130) AYR,AMN,ADY,lda,iut,imm,res_iutimm c 802 continue ! end cycle on MINUTE c 801 continue ! end cycle on UT 73 format(1X,3A2,2(1X,I2),3(2X,F5.0),2(2X,F5.1)) C C-- 500 CONTINUE ! next day C 72 format(A6,24(1X,F4.1),1X,F7.2) ct 75 continue ! <<<<<<<<<<<<<<<<<< CLOSE(unit=10) CLOSE(unit=12) goto 900 2 CONTINUE write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 900 continue c pause ' ' RETURN END C ============================================================================ C C C ===============================================================