program bufrascii !------------------------------------------------------------------------------! !BUFRASCII | DECODIFICA DADOS EM FORMATO BUFR | LMAG| !------------------------------------------------------------------------------| ! ! ! Este programa le um arquivo bufr de dados observacionais ! ! e lista os descritores e dados correspondentes em uma tabela ! ! | ! Lucas Moreira de Araujo Gonçalves ! ! ! !------------------------------------------------------------------------------! !DEPENDENCIAS: MBUFR-ADT ! !------------------------------------------------------------------------------! 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 progrma principal integer ::i,f,J,nsubsets integer*2 ::argc integer :: iargc character(len=255)::infile,outfile,outfile1,outfile2,auxc integer :: nmm !................................Numero maximo de mesagens integer :: nm !.................................Numero de mensagens bufr integer*2 ::numchar integer::icod 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 character(len=50),dimension(1:11) :: Mat logical :: exist !} ! Inicio do programa !{ Pega os argumentos de Entrada: Data e Nomes dos arquivos de entrada e saida AUXTXT="" argc = iargc() if ((argc==3)) then print *,"+------------------------------------------------------------------+" PRINT *,"| bufrascii / mbufrtools V1.8 |" print *,"+------------------------------------------------------------------+" i=1;call GetArg(i,infile) i=2;call GetArg(i,auxc) read(auxc,*)nmm i=3;call GetArg(i,auxc) read(auxc,*)nss print *," Input filename: ",trim(infile) print *," Max number of mensagens: ",nmm print *," Max number of subsets: ",nss else print *,"-------------------------------------------------------------------" PRINT *," bufrascii infile nmessages nsubsets" print *," infile = Bufr input file name " print *," nmessages = Maximum number of messagens " print *," nsubsets = Maximum number of subsets per messages " print *,"---------------------------------------------------------------------" stop endif !} !{ Ler nome dos descritores da tabela A tabA(:)="" call getenv('MBUFR_TABLES',mbufr_tables) !{ Acrescenta barra no final do diretorio local_tables, caso seja necessario ! Nesse processo verifica 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 o nome dos descritores da tabela B mbufr_tableB=trim(mbufr_tables)//"B0000461300.txt" 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 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,46,13,0) !open(3,file=outfile,status="unknown") nm=0 !{ Processa a leitura de cada uma das mensagens do arquivo abertor 10 CONTINUE nm=nm+1 Call READ_MBUFR(1, 3000,sec1,sec3,sec4, bUFR_ED, NBYTES,err) If ((NBYTES > 0).and.(IOERR(1)==0)) Then write(outfile1,'("bufr_",I3.3,I2.2,2I3.3)')sec1%center,sec1%bType,sec1%bsubtype,sec1%MasterTable write(outfile2,'(I3.3,I4.4,4I2.2,".dat")')sec1%LocalTable,sec1%year,sec1%month,sec1%day,sec1%hour,sec1%minute outfile=trim(outfile1)//trim(outfile2) INQUIRE (FILE = outfile, EXIST = exist) open(3,file=outfile,ACCESS="append",status="unknown") nsubsets=sec3%nsubsets if(err>=0) then if ((nsubsets>nss).and.(nss>0)) nsubsets=nss if (.not. exist) then !#############IMPRESSAO DO NOME DOS DESCRITORES############## do i=1,sec4%nvars if (sec4%d(i,1)/=null) then if ((sec4%d(i,1)<99999).and.(sec4%d(i,1)>0)) then txt=tabncod(sec4%d(i,1)) else txt="" end if end if if ((sec4%C(i,1)==0).or.(sec4%C(i,1)==1)) then if (i/=sec4%nvars) then write(3,'(a,";",\)')trim(txt) else write(3,'(a)')trim(txt) end if end if end do !#############IMPRESSAO DOS DESCRITORES###################### do i=1,sec4%nvars if ((sec4%C(i,1)==0).or.(sec4%C(i,1)==1)) then if (i==sec4%nvars) then write(3,'(i6.6)')sec4%d(i,1) else write(3,'(i6.6,";",\)')sec4%d(i,1) end if end if end do end if numchar=0 !##############IMPRESSAO DOS VALORES####################### do j=1,nsubsets do i=1,sec4%nvars if (sec4%C(i,j)>0) numchar=numchar+1 55 if (numchar>0) then if (sec4%c(i,j)==numchar) then IF (numchar>255) numchar=255 auxtxt(numchar+1:numchar+1)=char(int(sec4%r(i,j))) txt2=txt else if (LEN_TRIM(AUXTXT)>0) then write(3,'(a,";",\)')trim(auxtxt)//(" ") else write(3,'("@@@@@@@;",\)') end if numchar=sec4%c(i,j) auxtxt="" goto 55 end if else if(sec4%r(i,j)/=null) then if (i==sec4%nvars) then write(3,'(F10.2)')sec4%r(i,j) else write(3,'(F10.2,";",\)')sec4%r(i,j) end if elseif (sec4%d(i,j)<99999) then if (i==sec4%nvars) then write(3,'(a6)')"Null" else write(3,'(a6,";",\)')"Null" end if else if (i==sec4%nvars) then write(3,'(a6)')"Null" else write(3,'(a6,";",\)')"Null" end if end if end if end do end do end if deallocate(sec3%d,sec4%r,sec4%d,sec4%c) if ((nm