C ======================================================== C subroutine SUBHEGRFH2(st) C...........................................................July 2024 C Read Hermanus and Grahamstown SANSA files C C---------------------------------------------------------------- C outfile1='c:/web/graf/2024/heMNf.br' C outfile2='c:/web/graf/2024/heMNh.br' C C program for extracting foF2 and hmF2 from DANSA daily files C C*********TEST C CHARACTER*128 OUTFILE1,OUTFILE2,INFILE,TXT +,indate !19 APR 2024 CHARACTER*2 AMN,AYR,ADY,DY1,DY2,CYR,CMN,CDY,CUT,CMM,CSS +,AMN_pre,AMN_cur,st CHARACTER*4 YEAR,CYEAR,newi,ncom CHARACTER*9 dati CHARACTER*5 fhei,fgri CHARACTER*7 hhei,hgri DIMENSION IF1(0:23),IH1(0:23) C C ++++++++++ 19 Apr 2024 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 C# indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!FEB2015 open(10,file=indate) !FEB2015 read(10,799) YEAR,AMN_cur,DY2,YEAR_pre,AMN_pre,DY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) YEAR, AMN_cur, DY2,YEAR_pre,AMN_pre,DY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) AYR=YEAR(3:4) AMN=AMN_cur C +++++++++++ 19 Apr 2024 33 format(A2) read(dy1,*) rdy1 idy1=int(rdy1) read(dy2,*) rdy2 idy2=int(rdy2) cc= WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',ctime C infile='c:/web/graf/WZ/heyrmndy.htm' infile(18:19)=ayr infile(20:21)=amn_cur infile(22:23)=DY2 C ii=0 outfile1='c:/web/graf/2011/he11f.br' outfile1(18:19)=st !he or gr outfile1(15:16)=ayr outfile1(20:21)=ayr outfile2=outfile1 outfile2(22:22)='h' C OPEN(21,FILE=OUTFILE1) ! foF2 OPEN(22,FILE=OUTFILE2) ! hmF2 C C Add reading outfile1, 2, prior given day C 332 FORMAT(3I2,2X,24(I3,2X)) 333 FORMAT(A128) icount=0 55 READ(21, 333, END=44) TXT ! foF2 C CYR=TXT(1:2) CMN=TXT(3:4) CDY=TXT(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then backspace(21) READ(21, 332, END=44) kyr1,kmn1,kdy1,(if1(k),k=0,23) goto 44 else icount=icount+1 GOTO 55 CONTINUE endif 44 mf_strings = icount C print*,'Strings in m_file:',m_strings REWIND (21) icount=0 C do while (icount.lt.mf_strings) READ(21, 333, END=444) TXT ! foF2 icount=icount+1 enddo 444 print*,'YES!' ENDFILE 21 close(UNIT=21) CCC C hmF2 icount=0 255 READ(22,333,END=244) txt CYR=txt(1:2) CMN=txt(3:4) CDY=txt(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.dy1)) then backspace(22) READ(22, 332, END=44) kyr2,kmn2,kdy2,(ih1(k),k=0,23) goto 244 else icount=icount+1 GOTO 255 CONTINUE endif 244 mh_strings = icount REWIND (22) icount=0 do while (icount.lt.mh_strings) READ(22, 333, END=446) txt ! remenber prec_DY1 lime icount=icount+1 enddo 446 print*,'YES!' ENDFILE 22 close(UNIT=22) C 35 format(13X,A4,3X,A2,3(2X,I2),6X,A5) 36 format(13X,A4,3X,A2,3(2X,I2),6X,F7.3) C OPEN(21,FILE=OUTFILE1,access='APPEND') OPEN(22,FILE=OUTFILE2,access='APPEND') C OPEN(23,FILE=INFILE,action='READ') C C foF2 iflag=0 C do 77 jd=idy1,idy2 ! cycle day-by-day do 77 lda=lda1,lda2 C if (jd.eq.idy2) AMN=AMN_cur if (lda.eq.lda1) then AMN=AMN_pre jd=idy1 else AMN=AMN_cur jd=idy2 endif read(AMN,*) rmn imn=int(rmn) call blet2(jd,ADY) C iut1=6 iut2=23 if (jd.eq.idy2) then iut1=0 iut2=5 endif C do 141 iut=iut1,iut2 iut=iut1 198 READ (23,*,END=193,ERR=211) newi,dati,cmn,cdy,cut,cmm,css,fhei ! foF2 (he & gr) +,fgri n=index(newi,'[new') IF (n.eq.0) THEN if (iflag.eq.0) then goto 198 else goto 141 endif ELSE iflag=1 ENDIF C CYEAR=dati(6:9) CYR=CYEAR(3:4) read(cyr,*) rkyr kyr=int(rkyr) C== if (cmn.eq.'6 ') cmn=AMN cmn=AMN read(cmn,*) rkmn kmn=int(rkmn) read(cdy,*) rkdy kdy=int(rkdy) C if ((kdy.ne.jd).or.(n.eq.0)) then backspace(23) goto 141 endif C read(cut,*) rkut kut=int(rkut) read(cmm,*) rkmm kmm=int(rkmm) ldak=ndoy(kyr,kmn,kdy) C C== IF ((CYEAR.eq.YEAR).AND.(kMN.eq.iMN).and.(kdy.eq.jd)) THEN !++1 IF ((CYEAR.eq.YEAR).AND.(ldak.eq.lda)) THEN !++1 if ((kut.eq.iut).and.(kmm.eq.0)) then !+ 2 if (st.eq.'he') then !+3 ncom=fhei(1:4) if(ncom.eq.'null') fhei='0.0' read(fhei,*) rfhe if1(kut)=nint(rfhe*10) iut=iut+1 else !3 ncom=fgri(1:4) if(ncom.eq.'null') fgri='0.0' read(fgri,*) rfgr if1(kut)=nint(rfgr*10) iut=iut+1 endif !3 else !+2 goto 198 endif !+ 2 goto 198 ENDIF !++ 141 continue 193 write(21,37) ayr,amn,ady,(if1(k),k=0,23) write(*,37) ayr,amn,ady,(if1(k),k=0,23) do k=0,23 if1(k)=0 enddo 77 continue ! end cycle day-to-day close(unit=21) C C hmF2 C do 78 jd=idy1,idy2 ! cycle day-by-day do 78 lda=lda1,lda2 !+++++++++++++++++++++++++++++++++++ if (lda.eq.lda1) then AMN=AMN_pre jd=idy1 else AMN=AMN_cur jd=idy2 endif read(AMN,*) rmn imn=int(rmn) call blet2(jd,ADY) C iut1=6 iut2=23 if (jd.eq.idy2) then iut1=0 iut2=5 endif C do 142 iut=iut1,iut2 iut=iut1 199 READ (23,*,END=194,ERR=211) newi,dati,cmn,cdy,cut,cmm,css,hhei ! hmF2 (he & gr) +,hgri n=index(newi,'[new') IF (n.eq.0) THEN if (iflag.eq.1) then goto 199 else goto 142 endif ELSE iflag=2 ENDIF CYEAR=dati(6:9) CYR=CYEAR(3:4) read(cyr,*) rkyr kyr=int(rkyr) c== if (cmn.eq.'6 ') cmn=AMN cmn=AMN read(cmn,*) rkmn kmn=int(rkmn) read(cdy,*) rkdy kdy=int(rkdy) C if ((kdy.ne.jd).or.(n.eq.0)) then backspace(23) goto 142 endif C read(cut,*) rkut kut=int(rkut) read(cmm,*) rkmm kmm=int(rkmm) ldak=ndoy(kyr,kmn,kdy) C C= IF ((CYEAR.eq.YEAR).AND.(kMN.eq.iMN).and.(kdy.eq.jd)) THEN !++ 1 IF ((CYEAR.eq.YEAR).AND.(ldak.eq.lda)) THEN !++1 if ((kut.eq.iut).and.(kmm.eq.0)) then !+ 2 if (st.eq.'he') then !vv 3 ncom=hhei(1:4) if(ncom.eq.'null') hhei='0.0' read(hhei,*) rhhe ih1(kut)=nint(rhhe) iut=iut+1 else !vv +3 ncom=hgri(1:4) if(ncom.eq.'null') hgri='0.0' read(hgri,*) rhgr ih1(kut)=nint(rhgr) iut=iut+1 endif !vv +3 else !2 goto 199 endif !2 GOTO 199 ENDIF !++1 142 continue 194 write(*,37) ayr,amn,ady,(ih1(k),k=0,23) write(22,37) ayr,amn,ady,(ih1(k),k=0,23) do k=0,23 ih1(k)=0 enddo 78 continue ! end cycle day-to-day !+++++++++++++++++++++++++ 196 close(unit=23) close(unit=22) C 37 format(3A2,2X,24(I3,2X)) C C goto 210 C 211 write(*,*) 'Error in input datafile:',infile pause ' ' 210 CONTINUE C C pause ' ' C STOP return END C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++