subroutine subngdc3c(stinp) C.....................................................................June 2026 C C extract data NGDC in .dat format C C- DIMENSION im(12) character*128 infile,outfilef,outfileh,outfilem,text,m_data +,indate C character*3 DDD character*2 AYR,AMN,ADY,st,CYR,CMN,CDY,ADY1,CUT,CMM +,STS_OUT(73),stinp,AMN_pre ! +,AUT character*4 AYEAR,AYEAR_pre,giro character*5 STCOD,fof2,hf2,hmf2,foes,tec,yf2,md c-- +,cs,fof1,scalef2,foe +,yf1,hmf1,mufd,hme character*30 STITLE(73),STATION CHARACTER*10 TIME,RTIME ! TEMP = 'YEAR-MN-DY' CHARACTER*19 TIMEIN ! TEMPIN = 'YEAR-MN-DY_UT_MM_SS' integer count,f_strings,h_strings dimension ifc(0:23),ihc(0:23),imc(0:23) +,cntf(0:23),cnth(0:23),cntm(0:23) +,fi(0:23),hi(0:23),xm(0:23) C DATA STS_OUT/ + 'al','as','ad','au','bb','bc','bp','br' +,'cj','cb','ch','cn','cq','bj','cw','db' +,'dw','er','eg','ei','ff','fz','ga','gg' +,'gr','gu','ha','he','ho','ic','if','jb' +,'jj','jm','jr','kk','kh','ll','lm','mg' +,'ml','mm','mo','mw','nc','nd','ni','ok' +,'pa','pe','pq','rm','ro','sa','sd','ea' +,'tr','tu','tv','vt','wk','wp','sp','wz' +,'yg','mh','at','eb','bl','gm','wa','qn' +,'pf'/ ! C_ DATA NUM_STS/ C_ + 'AL945','AS00Q','AS237','AU930','BBJ3R','BC840','BP440','BR52P' C_ +,'CAJ2M','CB53N','RL052','CN53L','09429','BVJ03','CW46O','DB049' C_ +,'DW41K','EA653','EG931','EI764','FF051','FZA0M','GA762','GU513' C_ +,'GR13L','GU421','HA419','HE13N','HO54K','IC437','IF843','JB57N' C_ +,'JJ433','JI91J','JR055','TO536','KB548','LL721','LM42B','MG560' C_ +,'ML449','MM168','MA155','MW26P','NI135','ND61R','NI63_','OK426' C_ +,'PA836','PE43K','PQ052','PRJ18','RO041','SAA0K','SD266','EA036' C_ +,'TR169','TUJ2O','TV51R','VT139','WK546','WP937','SO148','MZ152' C_ +,'YG431','MHJ45','AT138','EB040','BLJ03','GM037','WA619','THJ76'/ C C DATA STITLE/ + 'Alpena_MI__USA.txt ' +,'Ascension_Island.txt ' +,'Ashkhabad__Turkmenia.txt ' +,'Austin__USA.txt ' +,'Bahia_Blanca__Argentina.txt ' +,'Boulder_CO__USA.txt ' +,'Beijing__China.txt ' +,'Brisbane__Australia.txt ' !_ 1 +,'Cachoeira_Paulista__Brazil.txt' +,'Canberra__Australia.txt . ' +,'Chilton__UK.txt ' +,'Camden__Australia.txt ' +,'Chongqing__China.txt ' +,'Boa_Vista__Brazil.txt ' +,'Casey__Australia.txt ' +,'Dourbes__Belgium.txt ' !__ 2 +,'Darwin__Australia.txt ' +,'Eareckson_Air_Station.txt ' +,'Eglin_AFB__USA.txt ' +,'Eielson.txt ' +,'Fairford__England.txt ' +,'Fortaleza__Brazil.txt ' +,'Gakona__AK__USA.txt ' +,'Guam__USA.txt ' !___ 3 +,'Grahamstown__South_Africa.txt ' +,'Guangzhou__China.txt ' +,'Hainan__China.txt ' +,'Hermanus__South_Africa.txt ' +,'Hobart__Australia.txt ' +,'I-Cheon__South_Korea.txt ' +,'Idaho_Natl_Lab__ID__USA.txt ' +,'Jang_Bodo__Antartica.txt ' !___ 4 +,'Jeju_Is.txt ' +,'Jicamarca.txt ' +,'Juliusruh__Germany.txt ' +,'Kokubunji__Japan.txt ' +,'Khabarovsk__Russia.txt ' +,'Lualualei__Hawaii.txt ' +,'Learmonth__Australia.txt ' +,'Magadan__Russia.txt ' !___ 5 +,'Manzhouli__China.txt ' +,'Murmansk__Russia.txt ' +,'Moscow__Russia.txt ' +,'Mawson__Australia.txt ' +,'Nicosia__Cyprus.txt ' +,'Niue_Island.txt ' +,'Norfolk__Australia.txt ' +,'Okinawa__Japan.txt ' !___ 6 +,'Pt_Arguello.txt ' +,'Perth__Australia.txt ' +,'Pruhonice__Czech_Republic.txt ' +,'Ramey__Puerto Rico.txt ' +,'Rome__Italy_RO041.txt ' +,'Sao_Luis.txt ' +,'Salekhard__Russia.txt ' +,'El_Arenosillo__Spain.txt ' !___7 +,'Tromso__Norway.txt ' +,'Tucuman__Argentina_TUJ2O.txt ' +,'Townsville__Australia.txt ' +,'San_Vito__Italy.txt ' +,'Wakkanai__Japan.txt ' +,'Wallops__USA.txt ' +,'Sopron__Hungary.txt ' +,'Warsaw__Poland.txt ' !___ 8 +,'Yamagawa__Japan.txt ' +,'Millstone_Hill__MA__USA.txt ' +,'Athens__Greece.txt ' +,'Roquetes__Spain.txt ' +,'Belem__Brazil.txt ' +,'Gibilmanna__Italy.txt ' +,'Wake_Island.txt ' +,'Thule__Greenland.txt ' !___ 9 +,'Poker_Flat.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)) Cnorm indate='c:/web/graf/date' ! Tamara indate='c:/web/graf/date' ! 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 c- WRITE(*,798) AYEAR, AMN, ADY,AYEAR_pre,AMN_pre,ADY1,lda2,lda1 !FEB2015 NEW FORMAT NUMBER = 798 close(unit=10) AYR=AYEAR(3:4) ! C- infile='c:\web\graf\ngdc\SAA0K_2020DDD.dat' ! Tamara infile='c:\web\graf\ngdc\STATION_NAME.txt ' ! Tamara C_ infile(26:27)=AYR ! Tamara 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) c# UT_Time foF2 hmF2 foF1 hmF1 foE zmE foEs fxI TEC c# Columns 4 5 6 7 8 9 10 11 12 c 2020 050 00:00:00 3.787 189.110 0.000 0.000 0.000 0.000 0.000 0.000 0.944 31 format(3X,A2,1X,I3,2(1X,I2),9X,F6.3,3X,F7.3) C C Select station: DO inum=1,73 ! st=STS_OUT(inum) if (st.eq.stinp) then C_ stcod=NUM_STS(inum) STATION=STITLE(inum) infile(18:)=STATION !Tamara ist=inum exit endif enddo 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 continue C 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 continue c 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 continue C 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 CC Day-to-day cycle CC DO 41 lda=lda1,lda2 do it=0,23 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 220 OPEN(10,file=infile,action='READ') read(10,*,end=51) text ! title line C c-- IFL=0 c-- ICNF2=0 ! count for data within [LT1,LT1+1] c-- SHRF2=0. c-- ICNH2=0 ! count for data within [LT1,LT1+1] c-- SHRH2=0. LT=LT+1 call blet2(lt,AUT) C_ 280 read(10,*,end=51) STCOD,alati,along,TIMEIN,fof2,yf1,foes,hmf1 +,giro,hf2,hmf2,md,mufd,hme,yf2,tec c-- +,cs,fof1,hmf1,scalef2,hme,foe,mufd,yf1,fbes ! Tamara RTIME=TIMEIN(1:10) CMN=RTIME(6:7) read(CMN,*) rmn kmn=int(rmn) CDY=RTIME(9:10) CUT=TIMEIN(12:13) CMM=TIMEIN(15:16) read(CUT,*) rut kut=int(rut) read(CMM,*) rmm kmm=int(rmm) C read(cdy,*) rdy kdy=int(rdy) if (kmn.lt.imn) goto 280 if (kdy.lt.idy) goto 280 if (kdy.gt.idy) goto 141 C C- if ((CDY.eq.ADY).and.(CUT.eq.AUT)) then IF (CDY.eq.ADY) THEN C if (kut.ge.lt) then C+ write(*,*)STATION,' ',STCOD,' ',alati,along,' ',TIMEIN,' ',fof2 C+ +,' ',hmf2,' ',md goto 44 else C c- if (kut.ge.LT) then C backspace(10) c- LT=LT+1 goto 280 endif ENDIF C 44 if (fof2(1:4).eq.'null') fof2='00.00' if (fof2(5:5).eq.' ') fof2(5:5)='0' if (fof2(4:4).eq.' ') fof2(4:4)='0' if (hmf2(1:4).eq.'null') hmf2='000.0' if (md(1:4).eq.'null') md='000.0' read(fof2,*) rfof2 read(hmf2,*) rhmf2 read(md,*) rmd C if (kmm.lt.30) then kkut=kut else kkut=kut-1 !prec 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 close(10) GOTO 220 C 51 close(10) 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 C 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 C 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 C 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) 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++++++++++++++++++