program converg1p C.........................................................Aug 2020 C Dixon -> Gibilmanna C.........................................................Mar 2020 C C.........................................................Sep 2019 C C.........................................................May 2018 C C.........................................................Mar. 2017 C C.........................................................Feb. 2015 C Extend List of stations C C.........................................................Mar. 2014 C C.........................................................Dec. 2013 C Use data & results in /graf/ C C.........................................................Oct. 2013 C Use fcF2 & hcF2 results of /graf/ C C.........................................................Apr. 2012 C........................................................ Apr. 2015 C 3 more stations C C Maps in IONEX format C ........................................................Dec. 2011 C Exclude usage of fres, hres from SMI option C ........................................................Dec. 2009 C Construct *.br file = (preceding month + current month) from \web\ results C C Add TEC calculation adjusted to foF2&hmF2, arrange input of kp-index C C ........................................................Aug. 2009 C Add conj.point restoration with SUBCONP.FOR subroutine........... C C ........................................................Oct. 2008 C Mover med restoration to 14 preceding days C Include: t0=1(0) write(not write) results for thia station/days C Include calculation of period for median in subclone.for C C ........................................................Aug. 2007 C Include file for set of stations.................... C ........................................................Mar. 2007 C Cycle on stations/data C C Combined extraction f,m data from different sources C c [1] from TK files (TK), MH, AT, WZ c [2] from SEC files c [3] from Ionka files (NS) c [4] from SGO files (SO) c [5] from .sao files (AU, SJ) c [6] from .xml files (DB) C [7] from RAL files (CH,PS,TR) DIMENSION IM(0:12) +,NSUBS(80),GLATS(80),GLONS(80) +,if2(31,0:23),ih2(31,0:23),im3(31,0:23) +,R12y(0:12) REAL rkp(0:366,0:7),prekp(0:7) +,CLATS(80),CLONS(80) ! conj. point coordinates INTEGER*2 JFS(80),JHS(80),JTS(80),NFULF,NFULM,MAXD2 +,id1,id2 CHARACTER(10) DD CHARACTER(10) TT CHARACTER(5) ZZ C +,resf(0:31,24),resm(0:31,24) CHARACTER*128 outfile1,outfile2,outfile3,txt +,outfile4,infile1,infile2,infile3,infile4,indate +,infile0 ! Sep 2019+ CHARACTER*30 STINP(80),STNAME CHARACTER*4 YEARR(80),TTT,YEAR CHARACTER*13 STAT,STATS(80) CHARACTER*1 fmh CHARACTER*2 ST,AMN,DY1,DY2 +,dd1,dd2,YY,DY11,DY22 +,STTT +,STS(80),AMNS(80),DY1S(80),DY2S(80),FULF(80),FULM(80) COMMON /BL1/ST,YEAR,YY,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22 +,STNAME COMMON /BL2/ STAT,GLAT,GLON,DD,TTT,ZZ,R12 COMMON /BL3/ STATS,STS,GLATS,GLONS,JFS,JHS,II,AMNS,JTS COMMON /BL4/ FULF,FULM,NFULF,NFULM,MAXD2 COMMON /BL5/ APROX,BPROX COMMON /BL6/ CLATS,CLONS COMMON /BL7/ YEARR COMMON /BL8/ IF2,IM3,IH2 COMMON /FIKP/rkp,prekp DATA IM/31,31,28,31,30,31,30,31,31,30,31,30,31/ DATA STS/ + 'as','at','bc','bp','br','cb','ch','cn','cq','cs' C +,'cw','jb','db','dw','eg','eb','gm','gr','gu','ha' ! jb > cr Mar 2020 +,'cw','jb','db','dw','eg','eb','di','gr','gu','ha' ! di > gm Aug 2020 +,'he','ho','jj','jm','jr','kk','lm','ml','mo','mq' +,'mw','nd','ni','ok','pe','pq','sa','rm','ro','vt' ! sa > ps +,'sq','tv','tr','wk','wp','wz','mm','tk','kg','mg' ! Mar 2020 C +,'sd','rv','tz','ns','so','mb','ei','gg','if','tu' !tu> nc +,'sd','rv','tz','ns','so','gm','ei','gg','if','tu' ! Nov 2020 +,'pa','fz','ff','kh','au','al','ga','nc','yg','ic' !fz> yk nc>di Sep 2019 C +,'ad','bb','bl','sv','lv','sj','sp','cj','er','ll'/ !Apr.2020 +,'ad','bb','bl','sv','mh','sj','sp','cj','er','ll'/ !Jan.2021 C DATA STATS/ ! + 'Ascension. ','Athens. ','Boulder. ' ! +,'Beijing. ','Brisbane. ','Canberra. ' ! +,'Chilton. ','Camden. ','Chongqing. ' ! +,'Cocos_Is. ','Casey. ','Jang_Bogo. ' ! Mar 2020 +,'Dourbes. ','Darwin. ','Eglin. ' ! C +,'Roquetes. ','Gibilmanna. ','Grahamstown. ' ! +,'Roquetes. ','Dikson. ','Grahamstown. ' ! di > gm Aug 2020 +,'Guangzhou. ','Hainan. ','Hermanus. ' ! +,'Hobart. ','Jeju. ','Jicamarca. ' ! +,'Juliusruh. ','Kokubunji. ','Learmonth. ' ! +,'Manzhouli. ','Moscow. ','MacQuarue_Is.' ! +,'Mawson. ','Niue. ','Norfolk_Is. ' ! +,'Okinawa. ','Perth. ','Pruhonice. ' ! +,'Sao_Luis. ','Ramey. ','Rome. ' ! Mar 2020 +,'San_Vito. ','Scott_Base. ','Townsville. ' ! +,'Tromso. ','Wakkanai. ','Wallops. ' ! +,'Warsaw. ','Murmansk. ','Tomsk. ' ! +,'Kaliningrad. ','Magadan. ','Salekhard. ' ! +,'Rostov. ','Tunguska. ','Novosibirsk. ' ! C +,'Sodankyla. ','Madimbo. ','Eielson. ' ! +,'Sodankyla. ','Gibilmanna. ','Eielson. ' ! Nov. 2020 +,'Guam. ','Idaho_NL. ','Tucuman. ' !<+tu> nc +,'Pt_Arguello. ','Fortaleza. ','Fairford. ' !<+fz> yk +,'Khabarovsk. ','Austin. ','Alpena. ' ! +,'Gakona. ','Nicosia. ','Yamagawa. ' ! Sep 2019 +,'I_Cheon. ','Ashkhabad. ','Bahia_Blanca.' ! !Apr.2020 C +,'Belem. ','Sverdlovsk. ','Louisvale. ' +,'Belem. ','Sverdlovsk. ','MillstonHill.' ! Jan 2021 +,'San_Juan. ','Sopron. ','Cachoeira. ' ! Jan.2019 +,'Eareckson. ','Lualualei. '/ !Jan. 2019 C DATA GLATS/ + -7.9, 38.4, 40.0, 40.0,-27.5,-35.3, 51.6,-34.0, 29.5,-12.2 C +,-66.3,-74.6, 50.1,-12.2, 30.4, 40.8, 37.6,-33.3, 23.1, 18.3 +,-66.3,-74.6, 50.1,-12.2, 30.4, 40.8, 73.5,-33.3, 23.1, 18.3 !Aug 2020 di ->gm +,-34.4,-42.9, 33.5,-12.0, 54.6, 35.7,-21.8, 49.6, 55.5,-54.5 +,-67.6,-19.1,-29.0, 26.3,-32.0, 50.0, -2.6, 18.5, 41.8, 40.6 ! AUG 2020 +,-77.9,-19.7, 69.7, 45.4, 37.8, 52.2, 68.0, 56.5, 54.7, 60.0 +, 66.5, 47.2, 61.6, 54.6, 67.4, 37.6, 64.7, 13.6, 43.8,-28.3 ! Nov. 2020 +, 34.8, -3.9, 51.7, 48.5, 30.4, 45.1, 62.4, 35.0, 29.2, 37.1 !Sep 2019 C +, 37.9,-38.7, -1.4, 56.4,-28.5, 18.5, 47.7,-22.7, 52.7, 21.4/ !!Apr.2020 +, 37.9,-38.7, -1.4, 56.4, 42.6, 18.5, 47.7,-22.7, 52.7, 21.4/ !!Jan.2021 DATA GLONS/ + 345.6, 23.6,254.7,116.3,152.9,149.1,358.7,150.7,106.4, 96.8 c +,110.5,164.2, 4.6,130.9,273.3, 0.5, 14.0, 26.5,113.4,109.3 +,110.5,164.2, 4.6,130.9,273.3, 0.5, 80.4, 26.5,113.4,109.3 !Aug 2020 di ->gm +, 19.2,147.2,126.5,283.1, 13.4,139.5,114.1,117.5, 37.3,159.0 +, 62.9,190.1,168.0,127.8,115.9, 14.6,315.8,292.8, 12.5, 16.7 ! AUG 2020 +,166.8,146.9, 19.0,141.7,284.5, 21.1, 33.0, 84.9, 20.6,151.0 +, 66.5, 39.7, 90.0, 83.2, 26.6, 14.1,212.9,144.9,247.3,333.1 ! Nov. 2020 +,239.5,321.6,358.2,135.1,262.3,276.4,215.0, 33.2,129.6,127.5 !Sep 2019 +, 58.3,297.7,311.6, 58.6,288.5,294.0, 16.6,315.0,185.9,201.8/ !Jan.2021 DATA CLATS/ + -2.8,-33.5,-55.4,-20.2, 40.4, 48.8,-53.4, 47.1, -9.5, 31.8 C +, 86.2, 73.3,-50.4, 30.6,-49.4,-43.7,-36.3, 34.0, -3.3, 0.6 +, 86.2, 73.3,-50.4, 30.6,-49.4,-43.7,-54.1, 34.0, -3.3, 0.6 !Aug 2020 di ->gm +, 32.6, 56.4,-14.4, -7.4,-51.3,-18.2, 41.6,-29.8,-45.3, 62.8 +, 74.0, 20.4, 37.2, -7.4, 51.7,-47.0,-14.1,-38.3,-40.6,-24.5 ! AUG 2020 +, 72.9, 34.5,-61.6,-28.1,-57.9,-46.9,-56.9,-37.5,-49.1,-43.6 +,-49.4,-37.0,-42.2,-35.9,-57.9,-36.3,-62.7, 2.3,-56.9, 14.0 ! Nov.2020 +,-46.2,-12.1,-54.0,-30.2,-47.7,-64.3,-61.4,-27.7,-10.5,-18.1 !Sep 2019 +,-22.0, 19.5,-16.2,-41.5,-62.6,-38.1,-44.5, 5.3,-45.3,-21.6/ !Jan.2021 DATA CLONS/ + 345.2, 37.7,240.3,114.7,163.3,162.6, 25.7,163.8,106.5, 95.1 C +,124.3,231.1, 29.1,134.3,268.8, 18.7, 29.1, 13.1,112.9,109.0 +,124.3,231.1, 29.1,134.3,268.8, 18.7, 95.2, 13.1,112.9,109.0 !Aug 2020 di ->gm +, 5.9,165.0,123.8,283.2, 40.1,134.4,115.5,115.0, 58.5,189.8 +, 4.8,197.2,180.0,125.8,119.0, 37.4,316.7,294.0, 30.2, 23.4 ! AUG 2020 +,250.1,153.8, 61.5,134.1,282.9, 44.1, 66.3, 92.1, 46.5,136.0 +, 83.9, 55.6, 96.5, 90.4, 62.1, 29.1,171.8,143.7,228.8,327.9 ! Nov. 2020 +,225.5,322.4, 24.7,128.4,254.4,269.1,176.6, 44.6,127.1,124.2 !Sep 2019 +, 68.2,295.9,312.6, 73.7,289.0,295.3, 37.3,312.9,164.9,194.1/ !Jan.2021 CC C CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ) TTT(1:4)=TT(1:4) WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT c indate='d:/web/graf/date' !!! Tamara !!!!!!! !FEB2015 open(10,file=indate) !FEB2015 read(10,799) YEAR,AMN,DD2,YEAR_pre,AMN_pre,ADY_pre !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) YEAR, AMN, DD2,YEAR_pre,AMN_pre,ADY_pre !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) 798 format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2)) 799 format(A4,2(1X,A2),1X,A4,2(1X,A2)) !FEB2015 NEW COMMAND NUMBER = 799 C- YEAR=DD(1:4) YY=YEAR(3:4) C- AMN=DD(5:6) read(amn,*) rmon mn=int(rmon) C- DY2=DD(7:8) DY2=DD2 read(dy2,*) rdy2 idy2=int(rdy2) idy1=idy2-1 C New month: if (idy2.eq.1) then mn=mn-1 call blet2(mn,AMN) idy2=im(mn) call blet2(idy2,DY2) idy1=idy2 endif call blet2(idy1,DY1) C C C Prepare List of full data -stations APROX=2.876820E-02 BPROX=4.601528 nfulf=0 nfulm=0 do i=1,80 fulf(i)='00' fulm(i)='00' enddo ii=0 maxd2=0 do 103 ist=1,80 ii=ii+1 nsub=2 c= if (ist.eq.4) nsub=5 !bp+xml if (ist.eq.48) nsub=1 !tk if (ist.eq.2) nsub=1 !at Sep 2019+ if (ist.eq.46) nsub=1 !wz Sep 2019+ C= if (ist.eq.25) nsub=1 !jr MAY 2020 jf=1 jh=1 if (idy1.eq.1) then jt=1 else jt=2 endif C STAT=STATS(IST) ST=STS(IST) glat=glats(ist) glon=glons(ist) xlat=clats(ist) xlon=clons(ist) write(*,299) NSUB,YEAR,AMN,DY1,DY2,GLAT,GLON,JF,JH,JT +,STAT,XLAT,XLON 299 format(1X,I1,1X,A4,3(1X,A2),2(1X,F5.1),3(1X,I1),1X,A13,2(1X,F5.1)) 99 format(17X,I1,2(1X,F5.1),7X,A4,3(1X,A2),3(2X,I1) +,4X,A30) STNAME=' ' STATS(ii)=STAT STS(II)=ST NSUBS(II)=NSUB GLATS(II)=GLAT GLONS(II)=GLON YEARR(II)=YEAR AMNS(II)=AMN DY1S(II)=DY1 DY2S(II)=DY2 JFS(II)=JF JHS(II)=JH JTS(II)=JT STNAME(1:2)=YY STNAME(3:4)=AMN STNAME(5:6)=DY2 STNAME(7:)=STAT do j=1,30 if (STNAME(j:j).eq.'.') then jp=j STNAME(jp:)='_iono.txt' exit endif enddo STINP(II)=STNAME CLATS(II)=XLAT CLONS(II)=XLON C if (jf.gt.0) then nfulf=nfulf+1 fulf(nfulf)=st endif C if (jh.gt.0) then nfulm=nfulm+1 fulm(nfulm)=st endif C if (ii.eq.1) then CALL SUBKPCA endif 103 continue iinum=ii CTemp C Start cycle on stations: do 105 ist=1,II STAT=STATS(IST) ST=STS(IST) NSUB=NSUBS(IST) GLAT=GLATS(IST) GLON=GLONS(IST) YEAR=YEARR(IST) YY=YEAR(3:4) AMN=AMNS(IST) DY1=DY1S(IST) DY2=DY2S(IST) JF=JFS(IST) JH=JHS(IST) JT=JTS(IST) STTT=STATS(IST) STNAME=STINP(IST) write(*,*) stat,st 38 continue C WRITE(*,*)'year:',YEAR,' month:',amn,' day1:',dy1,' day2:',dy2 C YY=YEAR(3:4) read(amn,*) rmon mn=int(rmon) read(year,*) ryear iyear=int(ryear) read(yy,*) yr iyr=int(yr) read(dy1,*) d1 id1=int(d1) read(dy2,*) d2 id2=int(d2) 159 z1=yr/4. jz=int(z1)*4 IF(jz.EQ.iyr) THEN IM(2)=29 ELSE IM(2)=28 ENDIF C Read R12 for current year: open(19,file='R12.dat',status='OLD') 211 read(19,*, end=199) j,(R12y(k),k=1,12) if (j.lt.iyear) then R12y(0)=R12y(12) goto 211 endif R12=R12y(mn) if (R12.gt.150.0) R12=150.0 199 continue close(unit=19) C IDNR=IM(MN) LHR=24*IDNR DD1='01' ! for input file title C define day of end of month: jd=idnr call blet2(jd,DD2) C outfile1='d:\web\graf\temp\styrf.br' outfile1(18:19)=ST outfile1(20:21)=YY outfile1(22:25)='f.br' C outfile2=outfile1 outfile2(22:25)='t.br' outfile3=outfile1 outfile3(22:25)='m.br' outfile4=outfile3 outfile4(22:25)='h.br' infile1='d:\web\graf\YEAR\styrf.br' infile1(13:16)=YEAR infile1(18:)=outfile1(18:) infile3=infile1 infile3(18:)=outfile3(18:) infile4=infile1 infile4(18:)=outfile4(18:) C C select case (nsub) C case (1) C TK: 1 continue c infile1='d:\web\graf\YEAR\styrf.br' infile2=infile1 infile2(10:10)='i' ! data foF2 TK,AT,JR,WZ in /grif/2014/tk14f.br C- if (ist.eq.43) then ! TR hmF2 Mar 2020 C- infile0=infile4 C- infile0(10:10)='i' ! mh Sep 2019+ C- open(13,file=infile4) ! mh record hmF2 Sep 2019+ C- open(14,file=infile0,action="READ") ! mh Sep 2019+ C- endif ! mh Sep 2019+ if ((ist.eq.2).or.(ist.eq.25).or.(ist.eq.46)) then ! AT, JR, WZ M3F2 Apr 2020 infile0=infile3 infile0(10:10)='i' ! at,jr, wz Apr 2020 open(13,file=infile3) ! at, jr, wz record M3F2 Apr 2020 open(14,file=infile0,action="READ") ! at, jr, wz Apr 2020 endif ! at, jr, wz Apr 2020 70 format(A128) open(11,file=infile1) ! record foF2 into /graf/ open(12,file=infile2,action="READ") ! read foF2 from /grif/ C C-NEW do i=1,80 777 read(12,70,end=71) txt ! read data foF2 for Tomsk, Juliusruh Athen Warsaw! Apr 2020 write(11,70) txt ! write data for Tomsk, Juliusruh Athen Warsaw! Apr 2020 if ((ist.eq.2).or.(ist.eq.25).or.(ist.eq.46)) then !at, tr, wz Mare 2020 read(14,70,end=71) txt ! read data M3F2 for Tomsk, Juliusruh Athen Warsaw! Apr 2020 write(13,70) txt ! write data for Tomsk, Juliusruh Athen Warsaw! Apr 2020 endif ! Apr 2020 goto 777 !-NEW C-NEW enddo 71 close(unit=11) close(unit=12) if ((ist.eq.2).or.(ist.eq.25).or.(ist.eq.46)) then !at, jr, wz Apr 2020 close(unit=13) ! Apr 2020 close(unit=14) ! Apr 2020 endif ! Apr 2020 goto 108 ! output results C SEC: case (2) 2 if (jt.eq.3) then if (DY1.eq.'01') then jt=1 else jt=2 endif c call subsec2(infile1,infile3,infile4) else goto 108 endif goto 108 ! output results C+++++++ end select C output results 108 continue C NEW++++ JT=2 means REMOVE the preceding day line from output files: fmh='t' ! Sep 2019 call subrecogp(fmh,outfile2) ! TEC C if (JF.GT.0) then fmh='f' call subrecogp(fmh,outfile1) ! f.br endif if (JH.GT.0) then fmh='m' call subrecogp(fmh,outfile3) ! m3.br fmh='h' call subrecogp(fmh,outfile4) ! hm.br endif C+++++++++++++++++++++++++++++++++++++++++++++++ c 702 JFS(IST)=JF JHS(IST)=JH C// if (st.eq.'sv') goto 102 !TEMP+++++++++++++++++++++++ call subdevgx(IST) ! DEVLOG 102 continue crem write(*,98) STAT,ST,NSUB,GLAT,GLON,YEAR,AMN,DY1,DY2,JF,JH,JT crem +,STTT,STNAME c write(19,98) STAT,ST,NSUB,GLAT,GLON,YEAR,AMN,DY1,DY2,JF,JH,JT c 98 format(1X,A13,A2,1X,I1,2(1X,F5.1),7X,A4,3(1X,A2) c +,1X,'f',I1,1X,'h',I1,1X,'t',I1,1X,A2,1X,A23) c pause' ' 105 continue c close(unit=19) C +++++++++++++++Avoid filling gaps for COMPLETE data for given day C 1000 continue C C ++++++++++++ Prepare for c.p. calculations ++++++++++++ DO 2001 ist=1,IINUM stat=stats(IST) st=sts(IST) sttt=STATS(IST) year=yearr(IST) yy=year(3:4) amn=amns(IST) read(amn,*) mn dy11=dy1s(IST) dy22=dy2s(IST) read(dy11,*) d1 ! starting day for clone id1=int(d1) read(dy22,*) d2 ! ending day for clone id2=int(d2) c glatk=GLATS(IST) c glonk=GLONS(IST) c call subdevfo5(st) C c- if (jfs(ist).eq.0) goto 2001 call subcongs(IST) ! conj.point 2001 continue pause ' ' STOP END c C***********************************************************