subroutine subdatngdc1c(st,AYEAR,AMN,ADY) C Keep only hourly data for output (0 = missed) C.....................................................................Mar 2024 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 infilef,infileh,outfilef,outfileh,txt,m_data character*3 DDD character*2 AYR,AMN,ADY,st,CYR,CMN,CDY,ADY1,sts(18) character*4 AYEAR,BYEAR character*5 STNAME(18),name integer count,f_strings,h_strings dimension ifc(0:23),ihc(0:23) +,fc30(0:23,2),hc30(0:23,2) +,fi(0:23),hi(0:23) DATA sts/'at','wz','br','cb','cs','db' +,'dw','ea','eb','ho','jr','nd' +,'ni','pe','qn','sp','tv','bc'/ DATA STNAME/'AT138','MZ152','BR52P','CB53N','CS31K','DB049' +,'DW41K','EA036','EB040','HO54K','JR055','ND61R' +,'NI63_','PE43K','THJ76','SO148','TV51R','BC840'/ C C C DO k=1,18 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) C-- infilef='c:\web\graf\ngdc\stYRMNf.txt' ! NEW /ngdc/ infilef='c:\web\graf\ngdc\snameMNf.txt' ! NEW /ngdc/ c infileh='c:\web\graf\ngdc\stYRMNh.txt' ! NEW /ngdc/ C-- infilef(18:19)=ST infilef(18:22)=name C-- infilef(20:21)=AYR infilef(23:24)=AMN infileh=infilef infileh(25:25)='h' C outfilef='c:\web\graf\2020\stYRf.br' outfilef(18:19)=st outfilef(13:16)=AYEAR outfilef(15:16)=AYR outfilef(20:21)=AYR outfileh=outfilef outfileh(22:22)='h' 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) 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).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 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).and.(cdy.eq.ady1)) then 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 C=============================================================== OPEN(11,file=outfilef,access='APPEND') OPEN(12,file=outfileh,access='APPEND') do k=0,23 do i=1,2 fc30(k,i)=0. hc30(k,i)=0. enddo enddo f30_pre=0. ! last 30min for prec day h30_pre=0. ! last 30min for prec day C C 131 format(A4,4(1X,I2),13X,F6.3) 132 format(A4,4(1X,I2),13X,F6.1) C++ 131 format(A4,4(1X,I2),12X,F6.3) C Dayly cycle C C DO 41 idy=idy1,idy2 idy=idy1 do it=0,23 C do ii=0,59 fi(it)=0. hi(it)=0. C enddo enddo lda=ndoy(iyr,imn,idy) call blet2(idy,ADY) call blet3(lda,DDD) C C? maxut=0 OPEN(10,file=infilef,action='READ') ! Open for every day OPEN(13,file=infileh,action='READ') ! Open for every day DO nn=1,20 read(10,333,end=34,err=34) txt ! title line read(13,333,end=134,err=134) txt ! title line 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 156 else goto 155 endif C 156 read(13,30,end=134) 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(13) goto 104 else goto 156 endif C// 104 iut=0 5 read(10,131,end=34,err=34) BYEAR,KMN,KDYf,MUTf,MINf,fof2 C1105 if ((KMN.lt.IMN).or.(kdy.lt.idy)) GOTO 5 if ((KDYf.gt.IDY).and.(MUTf.ne.iut)) THEN C++ if (KDYf.gt.IDY) THEN fi(iut)=0.0 C backspace(10) goto 75 C++ close(unit=10) C++ GOTO 141 endif IF ((KDYf.eq.IDY).and.(MUTf.lt.iut)) goto 5 IF ((KDYf.eq.IDY).and.(MUTf.eq.iut).and.(MINf.eq.MINCOMP)) THEN fi(iut)=foF2 ENDIF C 75 read(13,132,end=34,err=134) BYEAR,KMN,KDYh,MUTh,MINh,hmf2 C++ if (KDYh.gt.IDY) THEN if ((KDYh.gt.IDY).and.(MUTh.ne.iut)) THEN hi(iut)=0. C backspace(13) goto 105 C++ close(unit=13) C++ GOTO 141 endif IF ((KDYh.eq.IDY).and.(MUTh.lt.iut)) goto 75 CC IF ((KDYh.eq.IDY).and.(MUTh.eq.iut).and.(MINh.eq.MINCOMP)) THEN hi(iut)=hmF2 endif 105 iut=iut+1 if (iut.lt.24) then goto 5 ENDIF 34 close(unit=10) 134 close(unit=13) C CC GOTO 122 CC do k=0,23 ifc(k)=0 ihc(k)=0 enddo C DO 40 iut=0,23 sum1f=0. sum2f=0. sum1h=0. sum2h=0. icnf1=0 icnh1=0 icnf2=0 icnh2=0 C C+ DO 240 imin=0,29 C imin=MINCOMP !+++ imin=0 foF2=fi(iut) hmF2=hi(iut) IF (imin.eq.MINCOMP) THEN !6 ifc(iut)=nint(foF2*10.) ihc(iut)=nint(hmF2) ENDIF !6 if (fof2.gt.0.) then !8 icnf1=icnf1+1 sum1f=sum1f+fof2 endif !8 if (hmf2.gt.0.) then !9 icnh1=icnh1+1 sum1h=sum1h+hmf2 endif !9 240 CONTINUE GOTO 40 ! ONLY min=00 C 3 CONTINUE DO imin=30,59 foF2=fi(iut) hmF2=hi(iut) if (fof2.gt.0.) then !11 icnf2=icnf2+1 sum2f=sum2f+fof2 endif !11 if (hmf2.gt.0.) then !12 icnh2=icnh2+1 sum2h=sum2h+hmf2 endif !12 ENDDO c- goto 1 C if (icnf1.gt.0) then !2 fc30(iut,1)=sum1f/icnf1 else !2 fc30(iut,1)=0. endif !2 if (icnf2.gt.0) then !3 fc30(iut,2)=sum2f/icnf2 else !3 fc30(iut,2)=0. endif !3 if (icnh1.gt.0) then !4 hc30(iut,1)=sum1h/icnh1 else !4 hc30(iut,1)=0. endif !4 if (icnh2.gt.0) then !5 hc30(iut,2)=sum2h/icnh2 else !5 hc30(iut,2)=0. endif !5 C 40 CONTINUE C 122 do iut=0,23 fut=fi(iut) hut=hi(iut) ifc(iut)=nint(fut*10.0) ihc(iut)=nint(hut) 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) write(*,32) AYR,AMN,ADY,(ihc(k),k=0,23) write(12,32) AYR,AMN,ADY,(ihc(k),k=0,23) 32 format(3A2,2X,24(I3,2X)) 41 CONTINUE 141 close(unit=11) close(unit=12) 51 CONTINUE ifsum=0 C do k=0,23 C ifsum=ifsum+ifc(k) C enddo RETURN END