C =========================================================== PROGRAM EXTSEC15d5a C....................................................OCT 2025 C Add produce tk(ns) C C Extract prec. data from monthly files C c DIMENSION IF2(31,24),IM3(31,24),IH2(31,24), ! *IM(0:12) ! CHARACTER*128 outfile1,outfile2,ctext,outfile3 !MAR2020 +,infile1,infile2,infile3 CHARACTER*120 m_data CHARACTER*10 CCM !MAR2020 CHARACTER*45 indate !FEB2015 Tamara 16 !!!!!!!!!!!!!!! CHARACTER*30 STNAME ! CHARACTER*15 STITLE(81),TITLES !FEB2015 CHARACTER*4 YEAR,YEAR_pre !FEB2015 CHARACTER*6 YYMMDD,Y0M0D0,Y1M1D1 CHARACTER*9 IONO CHARACTER*1 fh ! APR 2024 LOGICAL NEWMN ! CHARACTER*2 ST,AMN,DY1,DY2,DDD,CDAY(0:31),DD1,DD2,YY ! *,FULF(81),FULM(81),DY22,STS(81),AMN_pre,ADY_pre !FEB2015 *,AMN1,AYR1,AMN0,AYR0,AYR_nex,AMN_nex,ADY_nex ! +,AMN_cur,CYR,CMN,CDY,ADY C- CHARACTER*1 yn DATA IM/31,31,28,31,30,31,30,31,31,30,31,30,31/ ! DATA STS/ + 'ad','at','bc','br','cb','cn','cq','cs','cw','jb' ! +,'db','dw','eg','eb','ga','bb','gu','ha','he','ho' ! +,'jj','jm','jr','kk','lm','ml','mo','mq','mw','nd' +,'ni','ok','pe','pq','rm','ro','vt','pf','tv','tr' !May 2024 +,'wk','wp','wz','gm','so','ff','kh','nc','mm','tk' ! +,'bp','ch','sa','ei','gg','if','tu','ns','kg','mg' ! +,'sd','rv','ma','pa','fz','au','al','yg','bl','ea' ! +,'mh','ic','di','gr','wa','sp','cj','er','ll','as' !JAN 2026 +,'qn'/ ! C DATA STITLE/ + 'Ashkhabad. ','Athens. ','Boulder. ' !=== Apr 2017 +,'Brisbane. ','Canberra. ','Camden. ' !=== Apr 2017 +,'Chongqing. ','Cocos_Is. ','Casey. ' !=== Apr 2017 +,'Jang_Bodo. ','Dourbes. ','Darwin. ' !=== Mar 2020 +,'Eglin. ','Roquetes. ','Gakona. ' !=== Apr 2017 +,'Bahia_Blanca.','Guangzhou. ' !=== May 2018 +,'Hainan. ','Hermanus. ','Hobart. ' !=== Apr 2017 +,'Jeju. ','Jicamarca. ','Juliusruh. ' !=== Apr 2017 +,'Kokubunji. ','Learmonth. ','Manzhouli. ' !=== Apr 2017 +,'Moscow. ','MacQuarue_Is.','Mawson. ' ! +,'Niue. ','Norfolk_Is. ','Okinawa. ' !=== Apr 2017 +,'Perth. ','Pruhonice. ','Ramey. ' !=== Apr 2017 c +,'Rome. ','San_Vito. ','Scott_Base. ' !=== Apr 2017 +,'Rome. ','San_Vito. ','Poker_Flat. ' !May 2024 +,'Townsville. ','Tromso. ','Wakkanai. ' !=== Apr 2017 +,'Wallops. ','Warsaw. ','Gibilmanna. ' !Nov 2020 +,'Sodankyla. ','Fairford. ','Khabarovsk. ' !=== Apr 2017 +,'Nicosia. ','Murmansk. ','Tomsk. ' !APR 2020 +,'Beijing. ','Chilton. ','Sao_Luis. ' !=== Mar 2020 +,'Eielson. ','Guam. ','Idaho_NL. ' !=== Apr 2017 +,'Tucuman. ','Novosibirsk. ','Kaliningrad. ' !=== May 2018 +,'Magadan. ','Salekhard. ','Rostov. ' !=== Apr 2017 +,'IPG-Moscow. ','Pt_Arguello. ','Fortaleza ' !=== May 2018 +,'Austin. ','Alpena. ','Yamagawa. ' !=== Jun 2017 +,'Belem. ','Arenosillo. ','MillstonHill.' ! Jan. 2021 +,'I_Cheon. ','Dikson. ','Grahamstown. ' ! Aug 2020 c +,'San_Juan. ','Sopron. ','Cachoeira. ' +,'Wake. ','Sopron. ','Cachoeira. ' !May 2024 +,'Eareckson. ','Lualualei. ','Ascension. ' !Sep. 2019 +,'Thule. '/ C COMMON /BL1/ST,YEAR,YY,AMN,DY1,DY2,DD1,DD2,ID1,ID2,JF,JH,JT,DY22, *STNAME COMMON /BL4/ FULF,FULM,NFULF,NFULM,MAXD2 C C Start: C IONO='_iono.txt' NEWMN=.FALSE. C C Use current year, month, day from file DATE: !FEB2015 C 799 format(A4,2(1X,A2),1X,A4,2(1X,A2)) !FEB2015 NEW COMMAND NUMBER = 799 798 format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2)) C# indate='c:/web/graf/date' !!! Tamara !!!!!!! !FEB2015 indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!FEB2015 open(10,file=indate) !FEB2015 read(10,799) YEAR,AMN_cur,DD2,YEAR_pre,AMN_pre,ADY_pre !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) YEAR, AMN_cur, DD2,YEAR_pre,AMN_pre,ADY_pre !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) AMN=AMN_cur C WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TTT !FEB2015 C YEAR=DD(1:4) !FEB2015 YY=YEAR(3:4) YYMMDD(1:2)=YY YYMMDD(3:4)=AMN YYMMDD(5:6)=DD2 Y0M0D0=YYMMDD C++ read(YY,*) ryr ! iyr=int(ryr) ! z1=iyr/4.0 ! jz1=int(z1)*4 ! IF(jz1.EQ.iyr) THEN ! IM(2)=29 ! ELSE ! IM(2)=28 ! ENDIF ! C+ kyr_nex=iyr read(AMN,*) rmn ! kmn=int(rmn) read(DD2,*) rdy ! kdy=int(rdy) kdy_nex=kdy+1 kmn_nex=kmn if (kdy_nex.gt.im(kmn)) then kdy_nex=1 kmn_nex=kmn+1 if (kmn_nex.gt.12) then kmn_nex=1 kyr_nex=iyr+1 endif endif call blet2(kyr_nex,AYR_nex) call blet2(kmn_nex,AMN_nex) call blet2(kdy_nex,ADY_nex) Y1M1D1(1:2)=AYR_nex Y1M1D1(3:4)=AMN_nex Y1M1D1(5:6)=ADY_nex DY1=ADY_pre DY2=DD2 if (DD2.eq.'01') NEWMN=.TRUE. ! C CCM=YEAR CCM(5:5)=' ' CCM(6:7)=AMN CCM(8:8)=' ' C C------------------------------------------------------------------------- !MAR2024 C C START CYCLE ON STATIONS C DO 1500 ista=1,81 !FEB2015 st=sts(ista) C 1999 if (ista.eq.27) goto 180 !mo CC CC Lowell stations: if ((ista.eq.2).or.(ista.eq.4).or.(ista.eq.5) ! JAN 2026 +.or.(ista.eq.8).or.(ista.eq.10).or.(ista.eq.11).or.(ista.eq.12) !at, br.cb,cs !JAN 2026 +.or.(ista.eq.13).or.(ista.eq.14).or.(ista.eq.15).or.(ista.eq.19) !db,dw,eb JAN 2026 +.or.(ista.eq.20).or.(ista.eq.21).or.(ista.eq.22).or.(ista.eq.23) ! JAN 2026 +.or.(ista.eq.25).or.(ista.eq.30).or.(ista.eq.31).or.(ista.eq.33) !ho,jr,nd JAN 2026 +.or.(ista.eq.34).or.(ista.eq.36).or.(ista.eq.37) ! JAN 2026 +.or.(ista.eq.38).or.(ista.eq.39) !ni,pe,pf JAN 2026 +.or.(ista.eq.40).or.(ista.eq.43).or.(ista.eq.44).or.(ista.eq.46) Jan 2026 +.or.(ista.eq.48).or.(ista.eq.52).or.(ista.eq.54).or.(ista.eq.56) !,tv,wz JAN 2026 +.or.(ista.eq.64).or.(ista.eq.65).or.(ista.eq.66).or.(ista.eq.67) !rv,ma JAN 2026 +.or.(ista.eq.69).or.(ista.eq.70).or.(ista.eq.71).or.(ista.eq.72) !ea,wa,sp,qn JAN 2026 +.or.(ista.eq.74).or.(ista.eq.75).or.(ista.eq.76).or.(ista.eq.77) +.or.(ista.eq.78).or.(ista.eq.79).or.(ista.eq.80).or.(ista.eq.81)) + then !JAN 2026 goto 1500 endif CC CC IPG: if ((ista.eq.59).or.(ista.eq.60).or.(ista.eq.61).or.(ista.eq.62) +.or.(ista.eq.63)) THEN GOTO 1500 endif CC OUTFILE1='/var/www/izmiran/ionosphere/weather/graf/2010/styrf.br' !Ljuba C# OUTFILE1='c:/web/graf/2010/styrf.br' !Tamara outfile1(42:45)=YEAR !Ljuba C# outfile1(13:16)=YEAR !Tamara outfile1(49:50)=YY !Ljuba C# outfile1(20:21)=YY !Tamara outfile2=outfile1 outfile2(51:51)='m' !Ljuba C# outfile2(22:22)='m' !Tamara outfile3=outfile1 outfile3(51:51)='h' !!Ljuba C# outfile3(22:22)='h' !Tamara write(*,*) '1) outfiles extsec15d4:' !c// write(*,*) 'outfile1=', ST, outfile1 write(*,*) 'outfile2=', ST, outfile2 write(*,*) 'outfile3=', ST, outfile3 write(*,*) '--------' C ------------------------------------------------------------ C NEW source data files: C# infile1='c:/web/graf/dat1/12/styrmn.txt' !Tamara !DEC2013 infile1='/var/www/izmiran/ionosphere/weather/graf/' infile1(42:59)='dat1/12/styrmn.txt' !Ljuba!DEC2013 write(*,*) 'extsec15d4 infile1=', infile1 !Ljuba!DEC2013 C# infile1(18:19)=YY !Tamara !DEC2013 infile1(47:48)=YY !Ljuba !DEC2013 C# infile1(23:24)=YY !Tamara !DEC2013 infile1(52:53)=YY !Ljuba !DEC2013 99 continue !FEB2015 Tamara C# infile2='c:/web/graf/dat5/12/styrmnm.txt' !Tamara !DEC2013 infile2='/var/www/izmiran/ionosphere/weather/graf/' !Ljuba infile2(42:60)='dat5/12/styrmnm.txt' !Ljuba write(*,*) 'Attention !!! extsec15d4 infile2=', infile2 !Ljuba!MAR2020 C# infile2(18:19)=YY !Tamara !DEC2013 infile2(47:48)=YY !Ljuba !DEC2013 C# infile2(23:24)=YY !Tamara !DEC2013 infile2(52:53)=YY !Ljuba !DEC2013 98 continue !FEB2015 Tamara C# infile3='c:/web/graf/dat6/12/styrmnh.txt' !Tamara !DEC2013 infile3='/var/www/izmiran/ionosphere/weather/graf/' infile3(42:60)='dat6/12/styrmnh.txt' write(*,*) 'Attention !!! extsec15d4 infile3=', infile3 !Ljuba!MAR2020 C# infile3(18:19)=YY !Tamara !DEC2013 infile3(47:48)=YY !Ljuba !DEC2013 C# infile3(23:24)=YY !Tamara !DEC2013 infile3(52:53)=YY !Ljuba !DEC2013 write(*,*) '2) infiles extsec15d4:' !c// write(*,*) 'infile1=', infile1 write(*,*) 'infile2=', infile2 write(*,*) 'infile3=', infile3 write(*,*) '--------' C C 299 STNAME(1:6)=YYMMDD TITLES=STITLE(ista) do k=2,15 if (titles(k:k).eq.'.') then !*** kk=k-1 exit endif enddo stname(7:)=titles(1:kk) kkk=kk+7 stname(kkk:)=iono ST=STS(ista) OUTFILE1(47:48)=ST !Ljuba C# OUTFILE1(18:19)=ST !Tamara write(*,*) ST, outfile1 OUTFILE2(47:48)=ST !Ljuba C# OUTFILE2(18:19)=ST !Tamara OUTFILE3(47:48)=ST !Ljuba C# OUTFILE3(18:19)=ST !Tamara write(*,*) '3) outfiles extsec15d4:' !c// write(*,*) 'outfile1=', ST, outfile1 write(*,*) 'outfile2=', ST, outfile2 write(*,*) 'outfile3=', ST, outfile3 write(*,*) '--------' CC if ((ista.eq.3).or.(ista.eq.6).or.(ista.eq.7).or.(ista.eq.9) ! FEB 2026 +.or.(ista.eq.16).or.(ista.eq.17).or.(ista.eq.18).or.(ista.eq.24) !cq,gu ! FEB 2026 +.or.(ista.eq.26).or.(ista.eq.28).or.(ista.eq.29).or.(ista.eq.32) !ha,he,kk,ml ! FEB 2026 +.or.(nst.eq.35).or.(ista.eq.41).or.(ista.eq.42).or.(ista.eq.45) !ok,kr,mm ! FEB 2026 +.or.(ista.eq.47).or.(ista.eq.49).or.(ista.eq.51).or.(ista.eq.53) ! FEB 2026 +.or.(ista.eq.55).or.(ista.eq.57).or.(ista.eq.68).or.(ista.eq.73)) ! FEB 2026 + goto 1501 !bp,yg,di,gr !May 2024 ! FEB 2026 ! FEB 2026 CC C C# infile1(21:22)=ST !Tamara !DEC2013 infile1(50:51)=ST !Ljuba !DEC2013 C# infile2(21:22)=ST !Tamara !DEC2013 infile2(50:51)=ST !Ljuba !DEC2013 C# infile3(21:22)=ST !Tamara !DEC2013 infile3(50:51)=ST !Ljuba !DEC2013 write(*,*) '4) intfiles extsec15d4:' !c// write(*,*) 'infile1=', ST, infile1 write(*,*) 'infile2=', ST, infile2 write(*,*) 'infile3=', ST, infile3 write(*,*) '--------' C jf=1 jh=1 jt=2 if (ista.eq.1) then !++++================ read(dd2,*) rdy2 id2=int(rdy2) nndy2=id2 C +++++++++++++++++++++++++++ ! C ! read(AMN,*) rmn ! imn=int(rmn) ! imn1=imn ! iyr1=iyr ! C NEW preceding day for start of month: ! IF (.not.NEWMN) THEN !1 id1=id2-1 ! ELSE ! 1 imn1=imn-1 ! if (imn1.eq.0) then ! << 2 imn1=12 ! iyr1=iyr1-1 ! if (iyr1.lt.0) iyr1=100+iyr1 ! c- id1=im(imn1) ! c- id2=id1 ! endif ! >> 2 id1=im(imn1) ! C-- id2=id1 ! id2=kdy ENDIF ! 1 ENDIF !+++++====================== call blet2(imn1,AMN1) ! call blet2(iyr1,AYR1) ! AMN=AMN1 ! YY=AYR1 ! CCM(3:4)=YY ! CCM(6:7)=AMN ! C C call blet2(id1,DD1) C ------------------------------------------------------- C Read data of prec month for the station: imn0=imn-1 iyr0=iyr if (imn0.eq.0) then imn0=12 iyr0=iyr0-1 endif call blet2(imn0,AMN0) call blet2(iyr0,AYR0) C# infile1(18:19)=AYR0 !Tamara DEC2013 infile1(47:48)=AYR0 !Ljuba DEC2013 C# infile1(23:24)=AYR0 !Tamara DEC2013 infile1(52:53)=AYR0 !Ljuba DEC2013 C# infile1(25:26)=AMN0 !Tamara infile1(54:55)=AMN0 !Ljuba DEC2013 C# infile2(18:19)=AYR0 !Tamara DEC2013 infile2(47:48)=AYR0 !Ljuba DEC2013 C# infile2(23:24)=AYR0 !Tamara DEC2013 infile2(52:53)=AYR0 !Ljuba DEC2013 C# infile2(25:26)=AMN0 !Tamara infile2(54:55)=AMN0 !Ljuba DEC2013 C# infile3(18:19)=AYR0 !Tamara DEC2013 infile3(47:48)=AYR0 !Ljuba DEC2013 C# infile3(23:24)=AYR0 !Tamara DEC2013 infile3(52:53)=AYR0 !Ljuba DEC2013 C# infile3(25:26)=AMN0 !Tamara infile3(54:55)=AMN0 !Ljuba write(*,*) '5) infiles extsec15d4:' !c// write(*,*) 'infile1=', ST, infile1 write(*,*) 'infile2=', ST, infile2 write(*,*) 'infile3=', ST, infile3 write(*,*) '--------' nd0=im(imn0) OPEN(15,file=INFILE1) OPEN(12,file=OUTFILE1) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89,err=8989,end=8989) ctext !!!!!11111111111 LIUBA added err=8888,end=8888 05.2025 Liuba write(12,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE2) OPEN(13,file=OUTFILE2) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89,err=8989,end=8989) ctext !!!!!11111111111 LIUBA added err=8888,end=8888 21.09.2025 Liuba C read(15,89) ctext !!!!!11111111111 áûëî write(13,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE3) OPEN(14,file=OUTFILE3) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(14,89) ctext enddo close(unit=15) C C Read data of current month for the station: C C# infile1(18:19)=AYR1 !Tamara DEC2013 C# infile2(18:19)=AYR1 !Tamara DEC2013 C# infile3(18:19)=AYR1 !Tamara DEC2013 C# infile1(23:24)=AYR1 !Tamara DEC2013 C# infile2(23:24)=AYR1 !Tamara DEC2013 C# infile3(23:24)=AYR1 !Tamara DEC2013 C# infile1(25:26)=AMN !Tamara DEC2013 C# infile2(25:26)=AMN !Tamara DEC2013 C# infile3(25:26)=AMN !Tamara DEC2013 C infile1='/var/www/izmiran/ionosphere/weather/grif/dat1/12/styrmn.txt' !Ljuba DEC2013 ïðîñòî ÍÀÏÎÌÈÍÀÍÈÅ êàêîå èìÿ ó ôàéëà infile1(47:48)=AYR1 !Ljuba DEC2013 infile2(47:48)=AYR1 !Ljuba DEC2013 infile3(47:48)=AYR1 !Ljuba DEC2013 infile1(52:53)=AYR1 !Ljuba DEC2013 infile2(52:53)=AYR1 !Ljuba DEC2013 infile3(52:53)=AYR1 !Ljuba DEC2013 infile1(54:55)=AMN !Ljuba DEC2013 infile2(54:55)=AMN !Ljuba DEC2013 infile3(54:55)=AMN !Ljuba DEC2013 write(*,*) '6) infiles extsec15d4:' !c// write(*,*) 'infile1=', ST, infile1 write(*,*) 'infile2=', ST, infile2 write(*,*) 'infile3=', ST, infile3 write(*,*) '--------' jj=nd0 ! jj days for prec month nd0=id1-1 jj=jj+nd0 ! jj days for two months if (nd0.eq.0) goto 1 OPEN(15,file=INFILE1) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89,err=8888,end=8888) ctext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LIUBA added err=8888,end=8888 write(12,89) ctext enddo 8888 close(unit=15) C OPEN(15,file=INFILE2) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89) ctext write(13,89) ctext enddo close(unit=15) C OPEN(15,file=INFILE3) do i=1,4 read(15,89) ctext ! extra lines enddo do i=1,nd0 read(15,89,err=8989,end=8989) ctext !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LIUBA added err=8888,end=8888 write(14,89) ctext enddo 8989 close(unit=15) C C AVOID COMMANDS OF READING OLD FILES *.br C# GOTO 1 ! DEC2013 89 format(A128) ! DEC2013 C DELETED COMMANDS BEFORE 1 CONTINUE ! DEC2013 C----------------------------------------------------------------- 1 continue C =================================== kfulf=0 kfulm=0 C DO 77 JD=id1,id2 ! day-to-day cycle jd=id1 call blet2(jud,DDD) CDAY(JD)=DDD C CCM(9:10)=DDD ist=0 C+++ CREM if (jd.eq.id1) then STNAME(1:6)=Y0M0D0 C++ Mos !06.07.2022 180 if (ista.eq.27) then !06.07.2022 call subextmosc !06.07.2022 endif !06.07.2022 C+ NS if ((ista.eq.58).and.(jd.eq.id1)) then C- call blet2(id1,DY1) !19 APR 2024 C- call blet2(id2,DY2) !19 APR 2024 close(unit=12) close(unit=13) close(unit=14) call subionka3c(if2,im3,ih2) ! NS endif C check full sets of foF2, M3F2 at DAY2: cntf=0 cntm=0 do n=1,24 if (IF2(JD,n).GT.999) IF2(JD,n)=0 ! if (IH2(JD,n).GT.999) IH2(JD,n)=0 ! if (IM3(JD,n).GT.999) IM3(JD,n)=0 ! if (IF2(JD,n).gt.0) cntf=cntf+1 if (jh.eq.1) then if (IM3(JD,n).gt.0) cntm=cntm+1 endif enddo !+APR 2020 if (cntf.eq.24) then kfulf=kfulf+1 endif if ((jh.eq.1).and.(cntm.eq.24)) then kfulm=kfulm+1 endif C C Output zero data for missing stations/data C 1501 if((ista.eq.1).or.(ista.eq.3).or.(ista.eq.6).or.(ista.eq.7) ! FEB 2026 +.or.(ista.eq.9).or.(ista.eq.16).or.(ista.eq.17).or.(ista.eq.18) !ha,he,kk,ml FEB 2026 +.or.(ista.eq.24).or.(ista.eq.26).or.(ista.eq.28).or.(ista.eq.29) !ok,kr,mm ! FEB 2026 +.or.(ista.eq.32).or.(ista.eq.35).or.(ista.eq.41).or.(ista.eq.42) ! FEB 2026 +.or.(ista.eq.45).or.(ista.eq.47).or.(ista.eq.49).or.(ista.eq.51) ! FEB 2026 +.or.(ista.eq.53).or.(ista.eq.55).or.(ista.eq.57).or.(ista.eq.68) ! FEB 2026 +.or.(ista.eq.73)) then ! FEB 2026 C do n=1,24 IF2(JD,n)=0 ! IH2(JD,n)=0 ! IM3(JD,n)=0 ! enddo C 188 FORMAT(3A2,A120) call blet2(id1,DY22) icnt=0 i_cnt=0 OPEN(12,file=OUTFILE1) 151 read(12,188,end=244) CYR,CMN,CDY,m_data if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.DY22)) THEN goto 244 else icnt=icnt+1 goto 151 endif 244 i_cnt=icnt rewind (12) icnt=0 do while (icnt.lt.i_cnt) read(12,188,end=248) CYR,CMN,CDY,m_data icnt=icnt+1 enddo 248 print*,'YES!',st ENDFILE 12 close(12) OPEN(12,file=OUTFILE1,access='APPEND') ! C icnt=0 i_cnt=0 OPEN(13,file=OUTFILE2) 152 read(13,188,end=245) CYR,CMN,CDY,m_data if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.DY22)) THEN goto 245 else icnt=icnt+1 goto 152 endif 245 i_cnt=icnt rewind (13) icnt=0 do while (icnt.lt.i_cnt) read(13,188,end=249) CYR,CMN,CDY,m_data icnt=icnt+1 enddo 249 print*,'YES!',st ENDFILE 13 close(13) OPEN(13,file=OUTFILE2,access='APPEND') ! C icnt=0 i_cnt=0 OPEN(14,file=OUTFILE3) ! 153 read(14,188,end=246) CYR,CMN,CDY,m_data if ((CYR.eq.YY).and.(CMN.eq.AMN).and.(CDY.eq.DY22)) THEN goto 246 else icnt=icnt+1 goto 153 endif 246 i_cnt=icnt rewind (14) icnt=0 do while (icnt.lt.i_cnt) read(14,188,end=250) CYR,CMN,CDY,m_data icnt=icnt+1 enddo 250 print*,'YES!',st ENDFILE 14 179 close(14) OPEN(14,file=OUTFILE3,access='APPEND') ! C DO 77 ndy=id1,id2 call blet2(ndy,DY22) c write(*,88) YY,AMN,DY22,(IF2(JD,k),k=1,24) write(12,88) YY,AMN,DY22,(IF2(JD,k),k=1,24) c if (jh.eq.1) then write(13,88) YY,AMN,DY22,(IM3(JD,k),k=1,24) ! write(*,88) YY,AMN,DY22,(IM3(JD,k),k=1,24) ! C write(14,88) YY,AMN,DY22,(IH2(JD,k),k=1,24) ! write(*,88) YY,AMN,DY22,(IH2(JD,k),k=1,24) ! endif CLOSE (unit=11) 77 continue ! go to the next day endif !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 88 format(3A2,2X,24(I3,2X)) ! C End of daily cycle =============== C goto 2 3 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY ' 2 continue CLOSE (unit=12) if (jh.eq.1) then CLOSE (unit=13) CLOSE (unit=14) ! endif 1500 CONTINUE ! End cycle on SEC stations C C Add IPG stations C DO nst=59,63 st=sts(nst) call subipg_dx1c(st) ENDDO C C Lowell stations C DO nst=1,81 IF ((nst.eq.2).or.(nst.eq.4).or.(nst.eq.5) +.or.(nst.eq.8).or.(nst.eq.10) !at, br.cb,cs +.or.(nst.eq.11).or.(nst.eq.12).or.(nst.eq.13).or.(nst.eq.14) !db,dw,eb +.or.(nst.eq.15).or.(nst.eq.19).or.(nst.eq.20).or.(nst.eq.21) +.or.(nst.eq.22).or.(nst.eq.23).or.(nst.eq.25).or.(nst.eq.30) !ho,jr,nd +.or.(nst.eq.31).or.(nst.eq.33).or.(nst.eq.34).or.(nst.eq.35) +.or.(nst.eq.36).or.(nst.eq.37).or.(nst.eq.38).or.(nst.eq.39) !May 2024 +.or.(nst.eq.40).or.(nst.eq.43).or.(nst.eq.44).or.(nst.eq.46) !ni,pe,tv,wz !May 2024 +.or.(nst.eq.48).or.(nst.eq.52).or.(nst.eq.54).or.(nst.eq.56) +.or.(nst.eq.64).or.(nst.eq.65).or.(nst.eq.66).or.(nst.eq.67) +.or.(nst.eq.69).or.(nst.eq.70).or.(nst.eq.71).or.(nst.eq.72) +.or.(nst.eq.74).or.(nst.eq.75).or.(nst.eq.76).or.(nst.eq.77) +.or.(nst.eq.78).or.(nst.eq.79).or.(nst.eq.80).or.(nst.eq.81)) + then !ea,sp,qn May 2024 C st=sts(nst) read(ADY_pre,*) rdy1 id1=int(rdy1) C C- DO 51 idy=id1,id2 DO 51 idy=1,2 !APR 2024 if (idy.eq.1) then !APR 2024 AMN=AMN_pre ADY=ADY_pre else AMN=AMN_cur ADY=DD2 endif if ((st.eq.'wz').or.(st.eq.'at')) then !1 fh='m' ! APR 2021 C__ call subdatngdc2a(st,YEAR,AMN,ADY) ! foF2 M3000 call subdatngdc2a(st,fh,YEAR,AMN,ADY) ! M3000 APR 2024 fh='f' ! APR 2024 call subdatngdc2a(st,fh,YEAR,AMN,ADY) ! foF2 ! APR 2024 endif if (st.ne.'wz') then !2 C__ call subdatngdc2a(st,YEAR,AMN,ADY) !foF2 hmF2 fh='f' !APR 2024 call subdatngdc2a(st,fh,YEAR,AMN,ADY) ! foF2 !APR 2024 fh='h' !APR 2024 call subdatngdc2a(st,fh,YEAR,AMN,ADY) ! foF2 !APR 2024 endif !2 C 51 CONTINUE ENDIF ENDDO C C pause ' ' ! Liuba c RETURN STOP END C subroutine blet2(ilet,alet2) c nn=1,2,3,4 CHARACTER*1 IN(0:9) C INTEGER*2 ilet !FEB2015 DATA IN/'0','1','2','3','4','5','6','7','8','9'/ CHARACTER*2 alet2 CLjuba a2='00' alet2='00' ! j10=ilet/10 j1=ilet-j10*10 5 do i=0,9 if (j10.eq.i) then alet2(1:1)=IN(i) endif enddo 7 do i=0,9 if (j1.eq.i) then alet2(2:2)=IN(i) endif enddo return end C