subroutine subdatngdc2a(st,fh,AYEAR,AMN,ADY) !May 2026 C Keep only hourly data for output (0 = missed) C.....................................................................APR 2024 C fh='f' foF2; fh='h' hmF2 C GIRO foF2 hmF2 scaled C AMN = mn-for-cnt, AMNI = input_mn C produce result = (Xave(UT-30m)+Xave(ut+30m))/2 C c DIMENSION im(12) character*128 infile,outfile,txt,m_data ! APR 2024 character*3 DDD character*2 AYR,AMN,ADY,st,CYR,CMN,CDY,ADY1,sts(49) character*4 AYEAR,BYEAR character*5 STNAME(49),name character*1 fh ! APR 2024 integer count,f_strings C +,h_strings ! APR 2024 dimension ifc(0:23) C +,ihc(0:23) ! APR 2024 +,fc30(0:23,2) C +,hc30(0:23,2) ! APR 2024 +,fi(0:23) C +,hi(0:23) ! APR 2024 DATA sts/'at','wz','br','cb','cs','db' +,'dw','ea','eb','ho','jr','nd' +,'ni','pe','qn','sp','tv','pf','wa' +,'al','as','au','bl','cj','er','eg','ei' +,'ga','gm','ic','jb','ll','mh','pq','ro' +,'ch','tr','vt','wp','ch','nc','pa','ff','if','jj','fz','lm','jm' +,'bj'/ DATA STNAME/'AT138','MZ152','BR52P','CB53N','CS31K','DB049' +,'DW41K','EA036','EB040','HO54K','JR055','ND61R' +,'NI63_','PE43K','THJ76','SO148','TV51R','PF765','WA619' +,'AL945','AS00Q','AU930','BLJ03','CAJ2M','EA653','EG931','EI764' +,'GA762','GM037','IC437','JB57N','LL721','MHJ45','PQ052','RO041' +,'RL052','TR169','VT139','WP937','RL052','NI135','PA836','FF051' +,'IF843','JJ433','FZA0M','LM42B','JI91J','BVJ03'/ C C C DO k=1,49 if (sts(k).eq.st) then name=STNAME(k) exit endif ENDDO C MINCOMP=0 C Add for JR IF (st.eq.'jr') mincomp=3 IF (st.eq.'nd') mincomp=2 C 1 continue read(AMN,*) rmn imn=int(rmn) C read(ADY,*) rdy idy1=int(rdy) idy2=idy1 idy=idy1 C call blet2(idy1,ADY1) call blet2(idy2,ADY) C AYR=AYEAR(3:4) read(AYR,*) ryr iyr=int(ryr) infile='c:\web\graf\ngdc\snameMNf.txt' ! NEW /ngdc/ ! APR 2024 infile(25:25)=fh ! APR 2024 C infile(18:22)=name ! APR 2024 infile(23:24)=AMN ! APR 2024 C outfile='c:\web\graf\2020\stYRf.br' ! APR 2024 outfile(22:22)=fh ! APR 2024 outfile(18:19)=st ! APR 2024 outfile(13:16)=AYEAR ! APR 2024 outfile(15:16)=AYR ! APR 2024 outfile(20:21)=AYR ! APR 2024 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 c 31 format(3X,A2,1X,I3,2(1X,I2),9X,F6.3,3X,F7.3) C+++++++++++++++++++++++++ 333 FORMAT(A128) C count=0 OPEN(88,FILE=outfile) ! APR 2024 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).and.(cdy.eq.ady1)) then 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--------------------------------------------------------------- ! APR 2024 C=============================================================== OPEN(11,file=outfile,access='APPEND') ! APR 2024 do k=0,23 do i=1,2 fc30(k,i)=0. C- hc30(k,i)=0. ! APR 2024 enddo enddo f30_pre=0. ! last 30min for prec day C- h30_pre=0. ! last 30min for prec day ! APR 2024 C C 131 format(A4,4(1X,I2),13X,F6.3) !fo 132 format(A4,4(1X,I2),13X,F6.1) !hm 133 format(A4,4(1X,I2),12X,F5.2) ! M3 C++ 131 format(A4,4(1X,I2),12X,F6.3) CC C Dayly cycle C C DO 41 idy=idy1,idy2 251 idy=idy1 do it=0,23 C do ii=0,59 fi(it)=0. C hi(it)=0. ! APR 2024 C enddo enddo lda=ndoy(iyr,imn,idy) call blet2(idy,ADY) call blet3(lda,DDD) C OPEN(10,file=infile,action='READ') ! Open for every day ! APR 2024 DO nn=1,20 read(10,333,end=34,err=34) txt ! title line ! APR 2024 ENDDO 155 read(10,30,end=34,err=34) m_data CYR=m_data(3:4) CMN=m_data(6:7) CDY=m_data(9:10) if ((cyr.eq.ayr).and.(cmn.eq.amn).and.(cdy.eq.ady)) then backspace(10) goto 104 else goto 155 endif C--------------------------------------------------------- ! APR 2024 C// 104 iut=0 iflag=0 5 if (fh.eq.'f') then read(10,131,end=34,err=34) BYEAR,KMN,KDYf,MUTf,MINf,fof2 endif if (fh.eq.'h') then read(10,132,end=34,err=34) BYEAR,KMN,KDYf,MUTf,MINf,fof2 endif if (fh.eq.'m') then read(10,133,end=34,err=34) BYEAR,KMN,KDYf,MUTf,MINf,fof2 endif C++ IF (KDYf.lt.IDY) goto 5 ! MAY 2024 IF ((KDYf.eq.IDY).and.(MUTf.lt.iut)) goto 5 ! MAY 2024 if (minf.eq.mincomp) then iflag=1 goto 114 endif if ((iflag.eq.0).and.(minf.le.15)) then !May 2024 iflag=1 minf=mincomp endif 114 if ((KDYf.gt.IDY).and.(MUTf.ne.iut)) THEN fi(iut)=0.0 goto 105 ! Apr 2024 endif C- IF ((KDYf.eq.IDY).and.(MUTf.lt.iut)) goto 5 !May 2024 IF ((KDYf.eq.IDY).and.(MUTf.eq.iut).and.(MINf.eq.MINCOMP)) THEN fi(iut)=foF2 iflag=1 ! May 2024 ENDIF C-------------------------------------------------------------- ! Apr 2024 105 iut=iut+1 iflag=0 if (iut.lt.24) then goto 5 ENDIF 34 close(unit=10) C- 134 close(unit=13) ! Apr 2024 C CC-------------------------------------------------- ! Apr 2024 C 122 do iut=0,23 fut=fi(iut) C- hut=hi(iut) ! Apr 2024 IF (fh.eq.'f') THEN ifc(iut)=nint(fut*10.0) ENDIF IF (fh.eq.'h') THEN ifc(iut)=nint(fut) ! Apr 2024 ENDIF IF (fh.eq.'m') THEN ifc(iut)=nint(fut*100.0) ! Apr 2024 ENDIF enddo C GOTO 123 C write(*,32) AYR,AMN,ADY,(ifc(k),k=0,23) write(11,32) AYR,AMN,ADY,(ifc(k),k=0,23) C- write(*,32) AYR,AMN,ADY,(ihc(k),k=0,23) ! Apr 2022 C- write(12,32) AYR,AMN,ADY,(ihc(k),k=0,23) ! Apr 2022 32 format(3A2,2X,24(I3,2X)) 41 CONTINUE 141 close(unit=11) C- close(unit=12) ! Apr 2022 51 CONTINUE ifsum=0 C do k=0,23 C ifsum=ifsum+ifc(k) C enddo RETURN END