program bufrdump !******************************************************************************* !* BUFRDUMP * !* * !* Descarrega dados e descritores de um arquivo BUFR para um arquivo texto. * !* (Dump data and descriptors from a BUFR file to a text file) * !* * * !* * !* Copyright (C) 2005 Sergio Henrique S. Ferreira * !* Waldenio Gambi de Almeida * !* * !* MCT-INPE-CPTEC-Cachoeira Paulista, Brasil * !* * !*-----------------------------------------------------------------------------* !* DEPENDENCIAS: MBUFR-ADT, GetArgs. * !******************************************************************************* ! HISTORICO: ! 2005 SHSF - Versao Original ! 2007-02 SHSF - Atualização do modulo MBUFR-ADT V 1.5 para compilação em ! Windows ( Microsoft Power Station) !MS$TITLE:'Program BUFRDUMP ' USE mbufr !USE msflib ! Para compilacao em Windows ( Microsoft Power Station ) implicit none !{ Declaracao das variaveis utilizadas em read_mbufr integer :: nss type(sec1type)::sec1 type(sec3type)::sec3 type(sec4type)::sec4 integer :: NBYTES,BUFR_ED integer :: err Real,parameter :: Null=-340282300 !...........................valor nulo !} !{ variaveis auxiliares do programa principal integer ::i,J,nsubsets integer*2 ::argc integer :: iargc character(len=255)::infile,outfile,auxc integer :: nmm !................................Numero maximo de mesagens integer :: nm !.................................Numero de mensagens bufr integer*2 ::numchar integer::icod integer::imaster_table,ilocal_table,icenter character(len=50)::ncod character(len=50),dimension(0:99999)::tabncod character(len=50),dimension(0:255)::tabA,tabCC1 character(len=255)::mbufr_tables,mbufr_tableA,mbufr_tableB,mbufr_commonTableC1 character(len=255)::TXT,TXT2 character(len=258)::AUXTXT !} ! Inicio do programa !{ Pega os argumentos de Entrada: Data e Nomes dos arquivos de entrada e saida argc = iargc() imaster_table=13 ilocal_table=0 icenter=46 if ((argc>=4).and.(argc<8)) then print *,"+------------------------------------------------------------------+" PRINT *,"| bufrdump / mbufrtools V3.0 |" print *,"+------------------------------------------------------------------+" i=1;call GetArg(i,infile) i=2;call GetArg(i,outfile) i=3;call GetArg(i,auxc) read(auxc,*)nmm i=4;call GetArg(i,auxc) read(auxc,*)nss if (argc>=5) then call GetArg(5,auxc) read(auxc,*)icenter end if if (argc>=6) then call GetArg(6,auxc) read(auxc,*)imaster_table end if if (argc==7) then call GetArg(7,auxc) read(auxc,*)ilocal_table end if print *," Input filename: ",trim(infile) print *," Output filename: ",trim(outfile) print *," Max number of mensagens: ",nmm print *," Max number of subsets: ",nss else print *,"-------------------------------------------------------------------" PRINT *," bufrdump infile outfile nmessages nsubsets {center} {master-table} {Local-Table}" print *," infile = Bufr input file name " print *," outfile= text output filename " print *," nmessages = 0 or Maximum number of messagens to dump " print *," nsubsets = 0 or Maximum number of subsets per messages " print *," center = Identification of Original/Generate Center [",icenter,"]" print *," master_table = Master Table Version [",imaster_table,"]" print *," local_table = Local table version [",ilocal_table,"]" print *,"---------------------------------------------------------------------" stop endif !} !{ Ler Tabela A tabA(:)="" call getenv('MBUFR_TABLES',mbufr_tables) !{ Acrescenta barra no final do diretorio local_tables, caso seja necessario ! Nesse processo veirifica se o diretorio contem barras do windows ou barra do linux i=len_trim(mbufr_tables) if ((mbufr_tables(i:i)/="\").and.(mbufr_tables(i:i)/="/")) then if (index(mbufr_tables,"\")>0) then mbufr_tables=trim(mbufr_tables)//"\" else mbufr_tables=trim(mbufr_tables)//"/" end if end if mbufr_tableA=trim(mbufr_tables)//"BufrTableA.txt" open(2,file=mbufr_tableA,status="unknown") 551 read(2,'(i3,1x,a50)',end=661)icod,ncod tabA(icod)=ncod goto 551 661 continue close(2) !} !{ Ler os nomes dos descritores da tabela B write(mbufr_tableB,'("B000",I3.3,I2.2,I2.2,".txt")')icenter,imaster_table,ilocal_table mbufr_tableB=trim(mbufr_tables)//trim(mbufr_tableB) open(2,file=mbufr_tableB,status="unknown") tabncod(:)="" 555 read(2,'(1x,i6,1x,a50)',end=666)icod,ncod tabncod(icod)=ncod goto 555 666 continue close(2) !} !{ Ler OS nome dos descritores da tabela comum C1 mbufr_commonTableC1=trim(mbufr_tables)//"CommonTableC1.txt" open(2,file=mbufr_commonTableC1,status="unknown") tabCC1(:)="" 553 read(2,'(i3,1x,a)',end=663)icod,ncod tabCC1(icod)=ncod goto 553 663 continue close(2) !} !{ Processa a leitura dos dados para cada um dos "nf" arquivos fornecidos. NBYTES = 0 Call OPEN_MBUFR(1, infile,icenter,imaster_table,ilocal_table) open(3,file=outfile,status="unknown") nm=0 !{ Processa a leitura de cada uma das mensagens do arquivo aberto. 10 CONTINUE nm=nm+1 Call READ_MBUFR(1, 6000,sec1,sec3,sec4, bUFR_ED, NBYTES,err) If ((NBYTES > 0).and.(IOERR(1)==0)) Then if((err==0).or.(err>20)) then write(3,'(1X,a,i2)')":BUFR: # EDITION =",BUFR_ED write(3,'(1X,I4," # MBUFR Error code")')err write(3,'(1X,a)')":SEC1:" write(3,'(1x,I4," # BUFR MASTER TABLE")')sec1%NumMasterTable write(3,'(1X,I4," # ORIGINATING CENTER: ",a50)')sec1%center,tabcc1(sec1%center) write(3,'(1X,I4," # ORIGINATING SUBCENTER")')sec1%subcenter write(3,'(1X,I4," # UPDATE SEQUENCE NUMBER")')sec1%update write(3,'(1X,I4," # DATA CATEGORY: ",a50)')sec1%bType,tabA(sec1%btype) write(3,'(1X,I4," # DATA SUBCATEGORY ")')sec1%intbsubtype write(3,'(1X,I4," # LOCAL DATA SUBCATEGORY ")')sec1%bsubtype write(3,'(1X,I4," # BUFR MASTER TABLE VERSION NUMBER")') sec1%VerMasterTable write(3,'(1X,I4," # LOCAL TABLE VERSION NUMBER")') sec1%VerLocalTable write(3,'(1X,I4," # YEAR ")')sec1%year write(3,'(1X,I4," # MONTH ")')sec1%month write(3,'(1X,I4," # DAY ")')sec1%day write(3,'(1X,I4," # HOUR ")')sec1%hour write(3,'(1X,I4," # MINUTE ")')sec1%minute write(3,'(1X,a)')":SEC3:" if ((sec3%nsubsets>nss).and.(nss>0)) sec3%nsubsets=nss write(3,'(1X,i5," # Num.subsets")')sec3%nsubsets write(3,'(1X,i5," # Num.descriptors")')sec3%ndesc write(3,'(1x,i5," # Flag for Compressed data (1=compressed 0=uncompressed)")')sec3%is_cpk nsubsets=sec3%nsubsets auxtxt="" numchar=0 do i=1,sec3%ndesc write(3,'(6x,i6.6)')sec3%d(i) end do end if if(err==0) then write(3,'(1X,":SEC4:")') if ((nsubsets>nss).and.(nss>0)) nsubsets=nss write(3,'(1x,i4," # N. ELEMENTS !")')sec4%nvars do j=1,nsubsets write(3,'(5x,":SUBSET ",I5.5,":")')j do i=1,sec4%nvars if (sec4%d(i,j)==null) goto 66 if ((sec4%d(i,j)<99999).and.(sec4%d(i,j)>0)) then txt=tabncod(sec4%d(i,j)) else txt="" end if if (sec4%C(i,j)>0) numchar=numchar+1 !{ Se for variavel corrente ou anterior for caracter entao processa essaparte 55 if (numchar>0) then !print *,sec4%d(i,j),sec4%c(i,j),numchar if (sec4%c(i,j)==numchar) then !...(Se Variavel corrente acumulla os caracteres) IF (numchar>255) numchar=255 auxtxt(numchar+1:numchar+1)=char(int(sec4%r(i,j))) txt2=txt ! Texto anterior else !......................(Se Variavel anterior, entao imprime a variavel) auxtxt(1:1)='"' auxtxt(numchar+2:numchar+2)='"' if (LEN_TRIM(AUXTXT)<=22) then write(3,'(1x,a22,1x,"# ",i6.6,"-"a50)')trim(auxtxt),sec4%d(i-1,j),txt2 else write(3,*) trim(auxtxt) end if numchar=sec4%c(i,j) auxtxt="" goto 55 end if else !} !{ Se for variavel do tipo numerica entao processa essa parte if(sec4%r(i,j)/=null) then write(3,'(1x,F22.5," # ",i6.6,"-",a50)')sec4%r(i,j),sec4%d(i,j),txt elseif (sec4%d(i,j)<99999) then write(3,'(1x,a22," # ",i6.6,"-",a50,1x)')"Null",sec4%d(i,j),txt else write(3,'(1x,a22," # ",i6.6)')"Null",sec4%d(i,j) end if !} end if 66 continue end do !nvars end do ! nsubsets write(3,'(1x,a)')":7777:" end if deallocate(sec3%d,sec4%r,sec4%d,sec4%c) if ((nm