program converg1p ! July.2025 C...........................................................! May 2019 C...........................................................!* Dec. 2018 C...........................................................!+++Aug. 2018 C...........................................................!June 2018 C.........................................................!May 2018 C C.........................................................!Mar. 2018 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 SEP 2019 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) !May 2019 +,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 !May 2019 INTEGER*2 JFS(80),JHS(80),JTS(80),NFULF,NFULM,MAXD2 !May 2019 +,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 !May 2019 Tamara +,infile0 ! Sep 2019+ CHARACTER*48 r_file ! Ljuba CHARACTER*30 STINP(80),STNAME !May 2019 CHARACTER*4 YEARR(80),TTT,YEAR !May 2019 CHARACTER*13 STAT,STATS(80) !May 2019 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) !May 2019 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' +,'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 +,'pf','tv','tr','wk','wp','wz','mm','tk','kg','mg' ! May 2024 +,'sd','rv','qn','ns','so','gm','ei','gg','if','tu' ! Mar 2024 +,'pa','fz','ff','kh','au','al','ga','nc','yg','ic' !fz> yk nc>di Sep 2019 +,'ad','bb','bl','ea','mh','wa','sp','cj','er','ll'/ !MAY.2024C DATA STATS/ ! + 'Ascension. ','Athens. ','Boulder. ' ! +,'Beijing. ','Brisbane. ','Canberra. ' ! +,'Chilton. ','Camden. ','Chongqing. ' ! +,'Cocos_Is. ','Casey. ','Jang_Bogo.' ! Mar 2020 +,'Dourbes. ','Darwin. ','Eglin. ' ! +,'Roquetes. ','Dikson. ','Grahamstown. ' ! 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. ','Poker_Flat. ','Townsville. ' ! May 2024 +,'Tromso. ','Wakkanai. ','Wallops. ' ! +,'Warsaw. ','Murmansk. ','Tomsk. ' ! +,'Kaliningrad. ','Magadan. ','Salekhard. ' ! +,'Rostov. ','Thule. ','Novosibirsk. ' ! Mar 2024 +,'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 +,'Belem. ','Arenosillo. ','MillstonHill.' ! Mar 2024 C +,'San_Juan. ','Sopron. ','Cachoeira. ' ! Jan.2019 +,'Wake. ','Sopron. ','Cachoeira. ' ! May.2024 +,'Eareckson. ','Lualualei. '/ !Jan. 2019 CC DATA GLATS/ + -7.9, 38.4, 40.0, 40.0,-27.5,-35.3, 51.6,-34.0, 29.5,-12.2 +,-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 +, 65.1,-19.7, 69.7, 45.4, 37.8, 52.2, 68.0, 56.5, 54.7, 60.0 !May 2024 +, 66.5, 47.2, 77.5, 54.6, 67.4, 37.6, 64.7, 13.6, 43.8,-26.9 ! June 2024 +, 34.8, -3.9, 51.7, 48.5, 30.4, 45.1, 62.4, 35.0, 29.2, 37.1 !Sep 2019 +, 37.9,-38.7, -1.4, 37.1, 42.6, 19.3, 47.7,-22.7, 52.7, 21.4/ !!MAY.2024 DATA GLONS/ + 345.6, 23.6,254.7,116.3,152.9,149.1,358.7,150.7,106.4, 96.8 +,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 +,212.6,146.9, 19.0,141.7,284.5, 21.1, 33.0, 84.9, 20.6,151.0 !mAy 2024 +, 66.5, 39.0,290.0, 83.2, 26.6, 14.0,212.9,144.9,247.3,294.6 ! JUNE 2024 +,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,353.3,288.5,166.6, 16.6,315.0,185.9,201.8/ !MAy.2024 DATA CLATS/ + -2.8,-33.5,-55.4,-20.2, 40.4, 48.8,-53.4, 47.1, -9.5, 31.8 +, 86.2, 73.3,-50.4, 30.6,-49.4,-43.7,-64.6, 34.0, -3.3, 0.6 !June 2024 di ->gm +, 32.6, 56.4,-14.4, -2.5,-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 +,-65.8, 34.5,-61.6,-28.1,-57.9,-46.9,-56.9,-37.5,-49.1,-43.6 !May 2024 +,-49.4,-42.8,-82.5,-35.9,-57.9,-36.3,-62.7, -6.0,-56.9, 17.4 ! MAR 2024 +,-46.2, -3.9,-54.0,-30.2,-47.7,-64.3,-61.4,-27.7,-10.5,-18.1 !Sep 2019 +,-22.0, 19.5,-16.2,-40.2,-62.6,-14.2,-44.5, 14.2,-45.3,-21.6/ !MAY.2024 DATA CLONS/ + 345.2, 37.7,240.3,114.7,163.3,162.6, 25.7,163.8,106.5, 95.1 +,124.3,231.1, 29.1,134.3,268.8, 18.7,162.4, 13.1,112.9,109.0 !Aug 2020 di ->gm +, 5.9,165.0,123.8,355.9, 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 +, 95.3,153.8, 61.5,134.1,282.9, 44.1, 66.3, 92.1, 46.5,136.0 !May 2024 +, 83.9,120.8,103.0, 90.4, 62.1, 29.1,171.8,143.4,228.8, 6.8 ! MAR 2024 +,225.5, 34.3, 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.0,289.0,123.1, 37.3, 26.3,164.9,194.1/ !MAY.2024 CC C C CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ) CALL DATE_AND_TIME(DD,TT,ZZ) ! Ljuba TTT(1:4)=TT(1:4) WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT c C indate='d:/web/graf/date' ! May 2019 Tamara indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! Liuba open(10,file=indate) ! May 2019 read(10,799) YEAR,AMN,DD2,YEAR_pre,AMN_pre,ADY_pre ! May 2019 WRITE(*,798) YEAR, AMN, DD2,YEAR_pre,AMN_pre,ADY_pre ! May 2019 close(unit=10) ! May 2019 798 format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2)) ! May 2019 799 format(A4,2(1X,A2),1X,A4,2(1X,A2)) ! May 2019 c C YEAR=DD(1:4) ! May 2019 YY=YEAR(3:4) C AMN=DD(5:6) ! May 2019 read(amn,*) rmon mn=int(rmon) C DY2=DD(7:8) ! May 2019 DY2=DD2 ! May 2019 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 !May 2019 fulf(i)='00' fulm(i)='00' enddo ii=0 maxd2=0 do 103 ist=1,80 !May 2019 ii=ii+1 nsub=2 if (ist.eq.48) nsub=1 !tk !+++Aug. 2018 jf=1 jh=1 if (idy1.eq.1) then jt=1 else jt=2 endif 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: C open(19,file='R12.dat',status='OLD') r_file='/var/www/izmiran/ionosphere/weather/graf/R12.dat' ! Ljuba open(19,file=r_file,status='OLD') ! Ljuba 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='/var/www/izmiran/ionosphere/weather/graf/temp/styrf.br' !Ljuba C outfile1(18:19)=ST C outfile1(20:21)=YY C outfile1(22:25)='f.br' outfile1(47:48)=ST !Ljuba outfile1(49:50)=YY !Ljuba outfile1(51:54)='f.br' !Ljuba C outfile2=outfile1 C outfile2(22:25)='t.br' outfile2(51:54)='t.br' !Ljuba C outfile3=outfile1 C outfile3(22:25)='m.br' outfile3(51:54)='m.br' !Ljuba outfile4=outfile3 C outfile4(22:25)='h.br' outfile4(51:54)='h.br' !Ljuba C infile1='d:\web\graf\YEAR\styrf.br' C infile1(13:16)=YEAR C infile1(18:)=outfile1(18:) infile1='/var/www/izmiran/ionosphere/weather/graf/YEAR/styrf.br' ! Ljuba infile1(42:45)=YEAR !Ljuba infile1(47:)=outfile1(47:) !Ljuba infile3=infile1 C infile3(18:)=outfile3(18:) infile3(47:)=outfile3(47:) !Ljuba infile4=infile1 C infile4(18:)=outfile4(18:) infile4(47:)=outfile4(47:) !Ljuba C WRITE(*,*) 'infile1 Converg1p = ',infile1 C select case (nsub) C case (1) C TK: 1 continue c infile1='d:\web\graf\YEAR\styrf.br' C infile2=infile1 !+++Aug. 2018 infile2='/home/tamara/ST/tk18f.br' !+++Aug. 2018 C infile2(10:10)='i' ! data foF2 (TK) in /grif/2014/tk14f.br C infile2(39:39)='i' ! data foF2 (TK) in /grif/2014/tk14f.br !Ljuba !+++Aug. 2018 infile2(19:20)=YY ! data foF2 (TK) in /home/tamara/ST/tk18f.br !Ljuba !+++Aug. 2018 infile2(17:18)=ST ! Sep 2019+ !Ljuba !+ Sep 2019 C 70 format(A128) open(11,file=infile1) open(12,file=infile2,action="READ") !! ,action="READ" Ljuba C C-NEW do i=1,80 777 read(12,70,end=71) txt ! read data for Tomsk TR AT WZ !-NEW write(11,70) txt ! write data for Tomsk TR AT WZ goto 777 !-NEW C-NEW enddo 71 close(unit=11) close(unit=12) C NEW SEP C?? if (ist.eq.46) then ! wz May 2024 C?? close(unit=13) ! tr APR 2020 C?? close(unit=14) ! tr APR 2020 C?? endif ! tr 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 ! Sep 2019 if (JF.GT.0) then fmh='f' call subrecogp(fmh,outfile1) ! f.br ! Sep 2019 endif if (JH.GT.0) then fmh='m' call subrecogp(fmh,outfile3) ! m3.br ! Sep 2019 fmh='h' call subrecogp(fmh,outfile4) ! hm.br ! Sep 2019 endif C+++++++++++++++++++++++++++++++++++++++++++++++ c 702 JFS(IST)=JF JHS(IST)=JH C== call subdevgx(IST) ! DEVLOG !! Mar 2021 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 c- if (jfs(ist).eq.0) goto 2001 call subcongs(IST) ! conj.point 2001 continue C pause ' ' ! Liuba STOP END c C***********************************************************