subroutine subngd3ch(stinp) C.....................................................................June 2026 C C extract data NGDC in SEC format C C- DIMENSION im(12) character*128 infile,outfilef,outfileh,outfilem,text,m_data +,indate character*2 AYR,AMN,ADY,st,CYR,CMN,CDY,ADY1,CUT,CMM +,stinp,AMN_pre ! +,AUT character*4 AYEAR,AYEAR_pre,CYEAR CHARACTER*10 TIME ! TEMP = 'YEAR-MN-DY' C? integer count,f_strings,h_strings dimension ifc(0:24),ihc(0:24),imc(0:24) +,cntf(0:24),cnth(0:24),cntm(0:24) +,fi(0:24),hi(0:24),xm(0:24) C C 'Chilton__UK.txt 'YRMNDDch.txt' 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 C indate='c:/web/graf/dates' ! Tamara TEMP C# indate='/var/www/izmiran/ionosphere/weather/graf/date' !!! LIUBA !!FEB2015 open(10,file=indate) !FEB2015 read(10,799) AYEAR,AMN,ADY,AYEAR_pre,AMN_pre,ADY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 799 WRITE(*,798) AYEAR, AMN, ADY,AYEAR_pre,AMN_pre,ADY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) AYR=AYEAR(3:4) ! st=STINP C- infile='c:\web\graf\ngdc\SAA0K_2020DDD.dat' ! Tamara C_ infile='c:\web\graf\ngdc\STATION_NAME.txt ' ! Tamara infile='c:\web\graf\2026\07\YRMNDDch.txt' infile(13:16)=AYEAR infile(18:19)=AMN infile(21:22)=AYR ! Tamara infile(23:24)=AMN infile(25:26)=ADY infile(27:28)=STINP read(AYR,*) ryr iyr=int(ryr) read(AMN,*) rmn iMN=int(rmn) c- write(*,*) ' Enter dy1,dy2:' read(ADY1,*) rdy1 idy1=int(rdy1) read(ADY,*) rdy idy2=int(rdy) C outfilef='c:\web\graf\2020\stYRf.br' ! Tamara outfilef(15:16)=AYR ! Tamara outfilef(20:21)=AYR ! Tamara C 30 format(A110) 31 format(3X,A2,1X,I3,2(1X,I2),9X,F6.3,3X,F7.3) C C Select station: C C Data for station C- DO 51 ist=1,65 C_ infile(18:22)=STCOD ! Tamara outfilef(18:19)=st ! Tamara outfileh=outfilef outfileh(22:22)='h' ! Tamara outfilem=outfilef outfilem(22:22)='m' ! Tamara C+++++++++++++++++++++++++ 333 FORMAT(A128) count=0 OPEN(88,FILE=outfilef) 255 READ(88, 333, END=244) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.ady1)) then !2020.07.01 goto 244 else count=count+1 GOTO 255 CONTINUE endif 244 f_strings = count REWIND (88) count=0 do while (count.lt.f_strings) READ(88, 333, END=248) m_data count=count+1 enddo 248 print*,'YES!',st ENDFILE 88 close(UNIT=88) C TLG ADD! CCC count=0 OPEN(55,FILE=outfileh) 355 READ(55, 333, END=344) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.ady1)) then ! 2020.07.01 goto 344 else count=count+1 GOTO 355 CONTINUE endif 344 h_strings = count REWIND (55) count=0 do while (count.lt.h_strings) READ(55, 333, END=348) m_data count=count+1 enddo 348 print*,'YES!',st ENDFILE 55 close(UNIT=55) C enddo CCC C M3000 count=0 OPEN(56,FILE=outfilem) 455 READ(56, 333, END=444) m_data CYR=m_data(1:2) CMN=m_data(3:4) CDY=m_data(5:6) if ((cyr.eq.ayr).and.(cmn.eq.amn_pre).and.(cdy.eq.ady1)) then ! 2020.07.01 goto 444 else count=count+1 GOTO 455 CONTINUE endif 444 h_strings = count REWIND (56) count=0 do while (count.lt.h_strings) READ(56, 333, END=348) m_data count=count+1 enddo 448 print*,'YES!',st ENDFILE 56 close(UNIT=56) C enddo C------------------------------------------- TIME = 'YEAR-MN-DY' TIME(1:4)=AYEAR C=============================================================== OPEN(11,file=outfilef,access='APPEND') OPEN(12,file=outfileh,access='APPEND') OPEN(13,file=outfilem,access='APPEND') C++ OPEN(10,file=infile,action='READ') C++ read(10,*,end=51) text ! title line CC OPEN(10,file=infile,action='READ') do k=1,16 read(10,*,end=51) text ! title lines enddo CC CC Day-to-day cycle CC DO 41 lda=lda1,lda2 do it=0,24 fi(it)=0. hi(it)=0. xm(it)=0. cntf(it)=0.0 cnth(it)=0.0 cntm(it)=0.0 ifc(it)=0 ihc(it)=0 imc(it)=0 enddo C C call submmdd(lda,iyr,imn,idy) call blet2(imn,AMN) TIME(6:7)=AMN call blet2(idy,ADY) TIME(9:10)=ADY CC CC Cycle on UT CC C ----------------------------------------------- C-- LT ! Start hour-to-hour cycle LT=-1 C 797 FORMAT(A4,2(1X,I2),2X,2I2,3X,F5.1,1X,I3,1X,F5.2) 220 LT=LT+1 call blet2(lt,AUT) C_ C_ 280 read(10,*,end=51) STCOD,alati,along,TIMEIN,fof2,hf2,giro,hmf2 280 read(10,797,end=141) CYEAR,kmn,kdy,kut,kmm,fof2,ihf2,xmd c-- +,cs,fof1,hmf1,scalef2,hme,foe,mufd,yf1,fbes ! Tamara C__ RTIME=TIMEIN(1:10) call blet2(kmn,CMN) call blet2(kdy,CDY) call blet2(kut,CUT) call blet2(kmm,CMM) C C C- if ((CDY.eq.ADY).and.(CUT.eq.AUT)) then if(kdy.gt.idy) then backspace(10) goto 141 endif C IF (CDY.eq.ADY) THEN C if (kut.gt.lt) then backspace(10) goto 220 endif if (kut.eq.lt) then write(*,797) CYEAR,kmn,kdy,kut,kmm,fof2,ihf2,xmd goto 44 else C goto 280 endif ENDIF C 44 if (fof2.eq.-1.0) fof2=0.0 if (ihf2.eq.-1) ihf2=0 if (xmd.eq.-1.00) xmd=0.0 rfof2=fof2 rhmf2=float(ihf2) rmd=xmd C if (kmm.lt.30) then kkut=kut else kkut=kut+1 !next hour if (kkut.lt.0) kkut=0 endif C if (rfof2.gt.0.) then fi(kkut)=fi(kkut)+rfof2 cntf(kkut)=cntf(kkut)+1.0 endif if (rhmf2.gt.0.) then hi(kkut)=hi(kkut)+rhmf2 cnth(kkut)=cnth(kkut)+1.0 endif if (rmd.gt.0.) then xm(kkut)=xm(kkut)+rmd cntm(kkut)=cntm(kkut)+1.0 endif C GOTO 280 C 141 DO iut=0,23 if (cntf(iut).gt.1.0) then fi(iut)=fi(iut)/cntf(iut) endif ifc(iut)=nint(fi(iut)*10.) if (cnth(iut).gt.1.0) then hi(iut)=hi(iut)/cnth(iut) endif ihc(iut)=nint(hi(iut)) if (cntm(iut).gt.1.0) then xm(iut)=xm(iut)/cntm(iut) endif imc(iut)=nint(xm(iut)*100.) enddo write(*,32) AYR,AMN,ADY,(ifc(k),k=0,23) ! 2020.07.01 write(11,32) AYR,AMN,ADY,(ifc(k),k=0,23) ! 2020.07.01 write(*,32) AYR,AMN,ADY,(ihc(k),k=0,23) ! 2020.07.01 write(12,32) AYR,AMN,ADY,(ihc(k),k=0,23) ! 2020.07.01 write(*,32) AYR,AMN,ADY,(imc(k),k=0,23) ! 2020.07.01 write(13,32) AYR,AMN,ADY,(imc(k),k=0,23) ! 2020.07.01 C 41 CONTINUE ! Day-to-day cycle C C+ 51 close(10) 51 close(10) 34 close(unit=11) close(unit=12) close(unit=13) C 32 format(3A2,2X,24(I3,2X)) Crem pause ' ' C STOP RETURN END C++++++++++++++++++