C subroutine subextmos subroutine subextmos1 C...........................................................July 2022 C Add reading Moscow Archive Parus data C c EXTRACT foF2 & M3000F2 $ hmF2 FROM DAILY-HOURLY FILE Moscow stations C DIMENSION im(12) +,jf2(0:23),jh2(0:23),jm3(0:23),aff(0:23,4),amm(0:23,4),ahm(0:23,4) C?? INTEGER*2 jyr,jmn,jdy,idy,idy1,idy2 CHARACTER*128 outfilef,outfilem,outfileh +,infmos,indate CHARACTER*4 YEAR,CYEAR,YEAR_pre !+++ +,fof CHARACTER*6 mos CHARACTER*49 txt CHARACTER*9 m3f CHARACTER*4 hmf CHARACTER*2 AYR,AMN,ST,DY1,DY2,ADY +,CMN,CYR,CDY,AMN_pre !+++ DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ C START=============================================================== C 799 format(A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3)) !FEB2015 NEW COMMAND NUMBER = 799 798 format(' YEAR, AMN, DD2 = ',A4,2(1X,A2),1X,A4,2(1X,A2),2(1X,I3)) indate='c:/web/graf/date' !!! Tamara !!!!!!! !FEB2015 C- indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!FEB2015 open(10,file=indate) !FEB2015 read(10,799) YEAR,AMN,DY2,YEAR_pre,AMN_pre,DY1,ndoy1,ndoy0 !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) YEAR, AMN,DY2,YEAR_pre,AMN_pre,DY1,ndoy0,ndoy1 !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) C 198 format(A40) read(DY1,*) rdy1 idy1=int(rdy1) read(DY2,*) rdy2 idy2=int(rdy2) 197 format(2(1X,A4,2(1X,A2)),1X,A2) C st='mo' ! Moscow C++ AYR=YEAR(3:4) C++ 199 format(A2) C ========================================================== C read(ayr,*) ryr jyr=int(ryr) read(amn,*) rmn jmn=int(rmn) if(int(ryr/4.)*4.eq.jyr) THEN im(2)=29 ELSE IM(2)=28 ENDIF do i=1,4 do k=0,23 aff(k,i)=0.0 amm(k,i)=0.0 ahm(k,i)=0.0 enddo enddo C C ========================================================== count=0 C OPEN(33,FILE=infile) outfilef='c:/web/graf/YEAR/stYRf.br' !Tamara outfilef(13:16)=YEAR !Tamara outfilef(18:19)=ST !Tamara outfilef(20:21)=AYR !Tamara outfilem=outfilef outfilem(22:22)='m' !Tamara outfileh=outfilef outfileh(22:22)='h' !Tamara c- outfilef='/var/www/izmiran/ionosphere/weather/graf/YEAR/stYRf.br' !LIUBA c- outfilef(42:45)=YEAR !LIUBA c= outfilef(47:48)=ST !LIUBA c outfilef(49:50)=AYR !LIUBA c outfilem=outfilef c outfilem(51:51)='m' !LIUBA c outfileh=outfilef c outfileh(51:51)='h' !LIUBA C Mos infmos='c:/web/graf/MO/stYRMNDY' !Tamara infmos(18:19)=AYR !Tamara infmos(13:14)=ST !Tamara infmos(16:17)=ST !Tamara infmos(20:21)=AMN !Tamara c infmos='/var/www/izmiran/ionosphere/weather/graf/MO/stYRMNDY' !LIUBA c infmos(47:48)=AYR !LIUBA c infmos(42:43)=ST !LIUBA c infmos(45:46)=ST !LIUBA c infmos(49:50)=AMN !LIUBA C EOF before to-day: OPEN(33,file=OUTFILEF) icount=0 m_strings=0 201 read(33,198,end=204) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then goto 204 else icount=icount+1 GOTO 201 CONTINUE endif 204 m_strings = icount REWIND (33) icount=0 C do while (icount.lt.m_strings) READ(33, 198, END=203) txt icount=icount+1 enddo 203 print*,'YES!' ENDFILE 33 close(UNIT=33) C EOF before to-day: OPEN(33,file=OUTFILEM) icount=0 m_strings=0 202 read(33,198,end=205) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then goto 205 else icount=icount+1 GOTO 202 CONTINUE endif 205 m_strings = icount REWIND (33) icount=0 C do while (icount.lt.m_strings) READ(33, 198, END=445) txt icount=icount+1 enddo 445 print*,'YES!' ENDFILE 33 close(UNIT=33) C hmF2 C EOF before to-day: OPEN(33,file=OUTFILEH) icount=0 m_strings=0 1201 read(33,198,end=1204) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.dy1)) then goto 1204 else icount=icount+1 GOTO 1201 CONTINUE endif 1204 m_strings = icount REWIND (33) icount=0 C do while (icount.lt.m_strings) READ(33, 198, END=1203) txt icount=icount+1 enddo 1203 print*,'YES!' ENDFILE 33 close(UNIT=33) C C OPEN(11,FILE=outfilef,access='APPEND') OPEN(12,FILE=outfilem,access='APPEND') OPEN(13,FILE=outfileh,access='APPEND') 331 format(A4,1X,A2,3(1X,I2),1X,F4.1) 332 format(A4,1X,A2,3(1X,I2),6X,F5.2) 336 format(A4,1X,A2,3(1X,I2),6X,F6.2) C do i=0,23 jf2(i)=0 jh2(i)=0 jm3(i)=0 enddo C DO 150 idy=idy1,idy2 do i=1,4 do k=0,23 aff(k,i)=0.0 amm(k,i)=0.0 ahm(k,i)=0.0 enddo enddo if (idy.eq.idy1) then !SEP 2022 ADY=DY1 !SEP 2022 else !SEP 2022 ADY=DY2 !SEP 2022 endif !SEP 2022 C++ call blet2(idy,ADY) !SEP 2022 C IF (st.eq.'mo') THEN ! start read-write Mos infmos(22:23)=ADY !!Tamara C infmos(51:52)=ADY !!LIUBA OPEN(33,FILE=infmos,action='READ') CMoscow 2020 02 13 00:00 foF2 03.1 MUF3000F2 10.4 hmF2 282 196 format(A6,1X,A4,1X,A2,3(1X,I2),1X,A4,1X,A5,2X,A9,1X,A5,2X,A4,2X +,A3) 191 format(A49) txt='Moscow foF2 MUF3000F2 hmF2 ' C 195 CONTINUE foF2=0. xm3000=0. xhmf=0. READ(33,*,END=194) mos,CYEAR,cmn,jdy,jut,jum +,fof,fof2,m3f,xmuf,hmf,xhmf C if (fof2.eq.0.) then xm3000=0. else xm3000=xmuf/fof2 endif C C Keep results for UT: jf2(jut)=nint(fof2*10.) jh2(jut)=nint(xhmf) jm3(jut)=nint(xm3000*100.) C GOTO 195 194 close(unit=33) write(*,334) ayr,amn,ady,(jf2(k),k=0,23) write(11,334) ayr,amn,ady,(jf2(k),k=0,23) write(*,334) ayr,amn,ady,(jm3(k),k=0,23) write(12,334) ayr,amn,ady,(jm3(k),k=0,23) write(*,334) ayr,amn,ady,(jh2(k),k=0,23) write(13,334) ayr,amn,ady,(jh2(k),k=0,23) do i=0,23 jf2(i)=0 jm3(i)=0 jh2(i)=0 enddo ENDIF ! end read-write mos c/ c/ 150 continue 444 print*,'YES!' close(UNIT=11) close(UNIT=12) close(unit=13) CCC C 333 call subcbkf1n(AYR,AMN,DY1,DY2,st) CCC 334 format(3A2,2X,24(I3,2X)) 335 format(2A2,I2,2X,24A5) C 152 pause ' ' C STOP RETURN END C ===============================================================