program bufrlist !****************************************************************************** !* BUFRLIST * !* * !* Programa para listar informações sobre os conteúdos de arquivos BUFR *. !* (Program to lists information about the BUFR files contains.) * !* * !* * !* Copyright (C) 2005 Sergio Henrique S. Ferreira * !* * !* MCT-INPE-CPTEC-Cachoeira Paulista, Brasil * !* * !* * !*----------------------------------------------------------------------------* !* Dependências: MBUFR-ADT, getargs * !* * !****************************************************************************** ! HISTORICO: ! 2005 - SHSF - Versao Inicial ! 20070606 - SHSF - Modificado paramentros de entrada e incluido a opcao -o USE MBUFR USE STRINGFLIB implicit none !{ Declaracao das variaveis utilizadas em read_mbufr integer :: nss type(sec1type)::sec1 ! Secao 1 type(sec3type)::sec3 ! Secao 3 type(sec4type)::sec4 ! Secao 4 integer :: MBYTES ! Numero de bytes de uma mensagem BUFR integer :: BUFR_ED ! Edicao BUFR integer :: err ! Codigo de Erro ! Real,parameter:: Null=-340282300 !valor nulo type(selecttype),dimension(1)::select !Define selecao de Tipos BUFR !} !{ Declaracao de variaveis do programa integer :: NBYTESF integer :: NMESSAGE integer :: NBYTES character(len=50),dimension(0:255):: TABA ! Tabela BUFR A character(len=50),dimension(0:255):: TABC1 ! Tabela Comum C1 integer,dimension(0:255,0:255,0:255,0:3) :: TOTAL_CENTROXTIPO !Totalizados de bytes por centros, tipos e edicao BUFR) integer,dimension(0:255,3):: total_centro ! Totalizador de bytes por centro e edicao BUFR integer ::l,i,f,J,k integer*2 ::argc integer :: iargc real :: aux character(len=255)::outfile ! Nome do arquivo de saida (opcional) character(len=255)::infile ! Variavel auxiliar para arquivos de entrada character(len=255),dimension(1000):: flist ! Lista com nome dos arquivos integer :: nf ! Numero de arquivos na lista character(len=255)::table_dir character(len=255)::text ! Variaveil auxiliar para texto character(len=1),dimension(100)::namearg !........... Nome dos argumentos! character(len=256),dimension(100)::arg !...................... argumentos! integer::narg !........ numero de argumentos efetivamente passados! !{ Pega os argumentos de Entrada (Data e Nomes dos arquivos de entrada e saida) outfile="" nf=0 call getarg2(namearg,arg,narg) ! ! if (Narg>0) then do i=1,narg if(namearg(i)=="o") then outfile=arg(i) else nf=nf+1 flist(nf)=arg(i) end if end do print *,"Processando leitura de ",nf,"arquivos..." else print *, "bufrlist {-o outfile} input_filelist " stop endif !} total_centroxtipo(:,:,:,:)=0 total_centro(:,:)=0 !} !------------------------------------- !Inicializacao das variaveis e tabelas !------------------------------------- !{ select(1)%btype=none ! Excluir a leitura de todos os tipos de mesagens bufr ! Somente a secao 1 de cada mensagem sera lida call getenv("MBUFR_TABLES",table_dir) if ((table_dir(i:i)/="\").and.(table_dir(i:i)/="/")) then if (index(table_dir,"\")>0) then table_dir=trim(table_dir)//"\" else table_dir=trim(table_dir)//"/" end if end if !{ Carrega tabela A infile=trim(table_dir)//"BufrtableA.txt" open(1,file=infile,status="unknown") TABA(1:255)="" 9 read(1,'(i3,1x,a)',end=20)i,text TABA(i)=text goto 9 20 close(1) !} !{Carregar Tabela C1 infile=trim(table_dir)//"CommonTableC1.txt" open(1,file=infile,status="unknown") TABC1( 1:255) ="" TABC1( 10: 25) = "Centros da Regiao I" TABC1( 26: 40) = "Centros da Regiao II" TABC1(111:139) = "Centros da Regiao II" TABC1(101:109) = "Centros da Regiao I" TABC1( 41: 51) = "Centros da Regiao III" TABC1( 51: 63) = "Centros da Regiao IV" TABC1( 64: 73) = "Centros da Regiao V" TABC1( 74: 99) = "Centros da Regiao VI" TABC1(104:159) = "Centros da Regiao III" TABC1(161:199) = "Centros da Regiao IV" TABC1(200:209) = "Centros da Regiao V" TABC1(217:253) = "Centros da Regiao VI" 8 read(1,'(i3,1x,a)',end=21)i,text TABC1(i)=text goto 8 21 close(1) !} !'{ Formatar tabelas do i = 0,255 l = 50 - Len_trim(TABA(i)) If (l > 0) then do j=1,l TABA(i) = trim(TABA(i)) // "." end do end if end do !---------------------------------------------------- ! Aqui comeca o processamento propriamente dito ! Nesta parte �feito a leitura das secoes 1 ! de todos os nf arquivos BUFR fornecidos e feito ! a contabilizacao dos dados por tipo e por centro ! gerador !--------------------------------------------------- !{ do F = 1, nf NBYTESF = 0 Call OPEN_MBUFR(1, flist(F),255,13,0) 10 CONTINUE Call READ_MBUFR(1, 20,sec1,sec3,sec4, bUFR_ED, MBYTES,err,select) If ((MBYTES > 0).and.(IOERR(1)==0)) Then if ((sec1%center>255).or.(sec1%btype>255)) then print *, "Erro: Centro ou tipo de dados desconhecido" print *, "centro=",sec1%center print *, "Dado tipo=",sec1%btype else i=sec1%center j=sec1%btype k=sec1%bsubtype l=BUFR_ED-1 TOTAL_CENTROXTIPO(i,j,k,l) = TOTAL_CENTROXTIPO(i,j,k,l) + MBYTES total_centro(i,l) = total_centro(i,l) + MBYTES NMESSAGE = NMESSAGE + 1 NBYTES = NBYTES + MBYTES NBYTESF = NBYTESF + MBYTES end if deallocate(sec3%d,sec4%d,sec4%r,sec4%c) GoTo 10 End If Close (1) end do !} Fim da leitura e contabilidade !{ Listagem dos resultados na tela if (len_trim(outfile)>0) then ! IMPRIMIR EM UM ARQUIVO DE SAIDA open(1,file=outfile,status="unknown") do bUFR_ED = 2,4 write(1,*) "--------------------------------------------------------" write(1,*) "Bufr Edicao " ,bUFR_ED DO i = 0,255 If (total_centro(i, bUFR_ED - 1) > 0) Then write(1,*)TABC1(i) do J = 0,255 do k=0,255 If (TOTAL_CENTROXTIPO(i, J,k,( bUFR_ED - 1)) > 0) Then aux=float(TOTAL_CENTROXTIPO(i, J,k, bUFR_ED - 1)) / 1000 write(1,100)j,taba(j),k,aux End If end do end do aux= float(total_centro(i, (bUFR_ED - 1))) / 1000 write(1,102)aux write(1,*)" " End If end do end do else ! IMPRIMIR NA TELA do bUFR_ED = 2,4 Print *, "--------------------------------------------------------" Print *, "Bufr Edicao " ,bUFR_ED DO i = 0,255 If (total_centro(i, bUFR_ED - 1) > 0) Then Print *, TABC1(i) do J = 0,255 do k=0,255 If (TOTAL_CENTROXTIPO(i, J,k,( bUFR_ED - 1)) > 0) Then aux=float(TOTAL_CENTROXTIPO(i, J,k, bUFR_ED - 1)) / 1000 write(*,100)j,taba(j),k,aux 100 format (7x,i2,1x,A50,"Subtipo = ",I3,F10.1," kBytes") End If end do end do aux= float(total_centro(i, (bUFR_ED - 1))) / 1000 write(*,102)aux 102 format(10x,'Total...........................................',f10.1,'kbytes') Print *, " " End If end do end do end if End