program bufrgen !****************************************************************************** ! BUFRGEN !* BUFRGEN * !* * !* Ler um arquivo texto (com Formato do BUFRDUMP) e gera um arquivo BUFR * . !* (Read a text file (BUFRDUMP format) and generate a BUFR file) * !* * !* * !* Copyright (C) 2005 Sergio Henrique S. Ferreira * !* Waldenio Gambi de Almeida * !* * !* MCT-INPE-CPTEC-Cachoeira Paulista, Brasil * !* * !* * !*----------------------------------------------------------------------------* !* DEPENDENCIAS: MBUFR-ADT, STRINGFLIB, Getarqs * !****************************************************************************** ! HISTORICO ! 2005 SHSF - Versao Original ! 2007-02 SHSF - Atualizacao modulo MBUFR-ADT V 1.5 ! 2008-06-20 SHSF - Atualizacao do modulo MBUFR-ADR V4.0. Novos elementos da ! secao 4 ainda nao estao sendo considerados sendo seus valores ! definidos como zero. Sao estes sec1%second, sec1%local_bsubtype ! e sec1%update use mbufr use stringflib implicit none character(len=255):: infile !.........................Arquivo de entrada character(len=255):: outfile !...........................Arquivo de saida character(len=255):: line !............Uma linha do arquivo de entrada character(len=255):: CCAI5 ! Variavel auxilar para codificar dados caracters logical:: newmessage integer:: messages integer:: erro integer :: i,s,i2 integer*2::argc integer::iargc,v integer::ilen character(len=255)::auxc integer:: icenter,imaster_table,ilocal_table !} !{ Declaracao de variaveis do MBUFR-ADT integer :: nss type(sec1type)::sec1 type(sec3type)::sec3 type(sec4type)::sec4 integer :: NBYTES,BUFR_ED integer :: err ! Real,parameter :: Null=-340282300 !valor nulo !} !{ Iniciando variaveis newmessage=.false. messages=0 !} !{ Pega os argumentos de Entrada: Data e Nomes dos arquivos de entrada e saida argc = iargc() ilocal_table=0 imaster_table=13 icenter=46 print *,"+------------------------------------------------------------------+" PRINT *,"| bufrgen / mbufrtools V4.0 |" print *,"+------------------------------------------------------------------+" if ((argc>=2).and.(argc<=5)) then call GetArg(1,infile) call GetArg(2,outfile) if (argc>=3) then call GetArg(3,auxc) read(auxc,*)icenter end if if (argc>=4) then call GetArg(4,auxc) read(auxc,*)imaster_table end if if (argc==5) then call GetArg(5,auxc) read(auxc,*)ilocal_table end if print *," Input filename: ",trim(infile) print *," Output filename: ",trim(outfile) print *," Center code: ",icenter print *," Master table: ",imaster_table print *," Local table: ",ilocal_table else print *, "bufrgen infile outfile {center} {master_table} {local_table}" print *, " " print *, " infile = Input file name" print *, " outfile = BUFR file name " 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 open(1,file=infile,status="old") ! Abre arquivo texto p/ leitura call open_mbufr(2,outfile,icenter,imaster_table,ilocal_table) ! Abre arquivo BUFR p/ gravacao 10 read(1,'(a)',end=999) line 11 call CutString(line,"#") !{ Identificando nova mensagem e bandeira de erro if (index(line,":BUFR:")>0) then read(1,*,end=999) erro if (erro==0) then newmessage=.true. messages=messages+1 end if end if if (newmessage) then if(index(line,":SEC1:")>0) then read(1,*,end=999) sec1%NumMasterTable read(1,*,end=999) sec1%center read(1,*,end=999) sec1%subcenter read(1,*,end=999) sec1%update read(1,*,end=999) sec1%btype read(1,'(a)',end=999)line; sec1%Intbsubtype = val(line) read(1,'(a)',end=999)line; sec1%bsubtype = val(line) read(1,*,end=999) sec1%VerMasterTable read(1,*,end=999) sec1%VerLocalTable read(1,*,end=999) sec1%year read(1,*,end=999) sec1%month read(1,*,end=999) sec1%day read(1,*,end=999) sec1%hour read(1,*,end=999) sec1%minute sec1%second=0 if (sec1%bsubtype<0) sec1%bsubtype=0 if (sec1%Intbsubtype<0) sec1%Intbsubtype=0 elseif(index(line,":SEC3:")>0) then read(1,*,end=999) sec3%nsubsets read(1,*,end=999) sec3%ndesc read(1,*,end=999) sec3%is_cpk allocate(sec3%d(sec3%ndesc),STAT=ERR) do i=1,sec3%ndesc read(1,*,end=999)v sec3%d(i)=v end do elseif(index(line,":SEC4:")>0) then read(1,*,end=999)sec4%nvars allocate(sec4%r(sec4%nvars,sec3%nsubsets),STAT=ERR) sec4%r(:,:)=0 s=0 55 read(1,'(a)',end=999)line call CutString(line,"#") if (index(line,":SUBSET")>0) then s=s+1 i=0 goto 55 end if if ((index(line,":SEC")>0).OR.(INDEX(LINE,":7777:")>0)) goto 11 if (index(line,'"')>0) then ! Variavel caracter line=between_invdcommas(line) do i2=2,len_trim(line)-1 i=i+1 sec4%r(i,s)=ichar(line(i2:i2)) end do else !Variavel Numerica ou nula i=i+1 sec4%r(i,s)=VAL(line) end if if (i<=sec4%nvars) goto 55 if (s0) then !> Coidifica a mensagem BUFR, apos encontrado ! o indicativo e fim da mensagem 7777 call write_mbufr(2,sec1,sec3,sec4) newmessage=.false. end if end if goto 10 999 continue close(1) call close_mbufr(2) end