MODULE MEXTRACTOR !****************************************************************************** !* MODULO MBUFR-MAT * !* * !* MODULO COMPLEMENTAR DO MBUFR-ADT PARA LEITURA E ORGANIZACAO DE ESTRUTURA* !* DE DADOS BUFR NA FORMA DE MATRIZES DO TIPO (OBSERVACAO, VARIAVEL) * !* * !* Os dados que compoe a matriz sao selecionados conforme um conjunto de * !* descritores bufr previamente especificados e conforme a confiabilidade * !* do dado. Os dados em BUFR não selecionados ou de baixa confiabilidade * !* sao descartados * !* * !* Copyright (C) 2005 Sergio Henrique S. Ferreira (SHSF) * !------------------------------------------------------------------------------- ! REVISAO HISTORICA ! 15/04/2007 Adoção de controle de qualidade por centro e tipo BUFR (Matriz minqc) USE stringflib USe datelib USE MBUFR USE MFORMAT20 USE METLIB implicit none !.......................................Todos as variaveis serao declaradas private public mbufr_initmat public mbufr_scanmessage public corBUFRmat public selecttype real,parameter :: missing=-340282300 integer::ncbtmax type(corBUFRmat),allocatable::cbt(:) !................Descritores das colunas da matriz B type(selecttype),dimension(16)::select integer,dimension(0:255,0:255)::minqc !....................Valor minimo do controle de qualidade real*8::date1,date2 !..................................Datas iniciais e finais da janela de tempo CONTAINS subroutine mbufr_initmat(cbtc,ncbtc,jdate1,jdate2) !{Variaveis da interface integer,intent(in)::ncbtc character(len=*),dimension(ncbtc),intent(in)::cbtc ! MATRIZ TEXTO QUE INFORMA DESCRITORES A SER USADO real*8,intent(in)::jdate1,jdate2 !} !{ Variaveis locais character(len=255),dimension(ncbtc*2)::desc,E1 integer::k,i,NE,J !} !} !{ Configurando data inicial e final date1=jdate1 date2=jdate2 !} !***************************************** ! Definindo os tipos de mensagens BUFR que ! serao descartadas na leitura ! !**************************************** !{ Excluindo o PILOT select(1)%btype=0; select(1)%bsubtype=any select(2)%btype=1; select(2)%bsubtype=any select(3)%btype=3; select(3)%bsubtype=any select(4)%btype=4; select(4)%bsubtype=any select(5)%btype=5; select(5)%bsubtype=any select(6)%btype=6; select(6)%bsubtype=any select(7)%btype=7; select(7)%bsubtype=any select(8)%btype=8; select(8)%bsubtype=any select(9)%btype=9; select(9)%bsubtype=any select(10)%btype=10; select(10)%bsubtype=any select(11)%btype=11; select(11)%bsubtype=any select(12)%btype=12; select(12)%bsubtype=any select(13)%btype=2; select(13)%bsubtype=101 select(14)%btype=2; select(14)%bsubtype=102 select(15)%btype=2; select(15)%bsubtype=103 select(16)%btype=2; select(16)%bsubtype=104 !} !------------------------------------------------------------------------------ ! OBTECAO DA MATRIZ DE ASSOCIACAO DE DESCRITORES BUFR PARA ! COLUNAS DE MATRIZ DE OBSERCACAO ( MATRIZ cbt ) !------------------------------------------------------------------------------ ! Isto e feito por intermedio de uma matriz texto (cbtc) que contem ! os descritores das variaveis que deseja-se extrair do BUFR, assim ! como as convercoes de unidades que serao feitas no momento da ! leitura. ! ! A conversao de unidade e estabelecida por um fator multiplicativo (Mult) ! e um Valor de referencia (Ref) informado em cbtc como se seguie ! ! cbtc(i)=DESCRITOR*MULT+REF ! ! Esta parte DESCRITOR, MULR e REF sao separados e colocados em CBT para ! que possa ser usado. ! !------------------------------------------------------------------------------ !{ ncbtmax=ncbtc*2 ! Por simplicidade assumimos que o numero de colunas nunca sera maior ! que o dobro de argumentos passados em CBTC allocate(cbt(ncbtmax)) cbt(:)%mult=1 cbt(:)%ref=0 cbt(:)%d=999999 K=0 DO I=1,ncbtc CALL sep_substrings(CBTC(I),",",E1,NE) DO J=1,NE K=K+1 DESC(K)=E1(J) cbt(k)%d=VAL(DESC(K)) cbt(k)%col=I END DO END DO !{ Obtendo o fator multiplicativos MULT DO I=1,K CALL sep_substrings(DESC(I),"*",E1,NE) IF (NE==2) cbt(I)%mult=VAL(E1(2)) END DO DO I=1,K CALL sep_substrings(DESC(I),"/",E1,NE) IF (NE==2) cbt(i)%mult=1/VAL(E1(2)) END DO !} !{Obtendo valores de Referencia DO I=1,K CALL sep_substrings(DESC(I),"+",E1,NE) IF (NE==2) cbt(i)%ref=VAL(E1(2)) END DO DO I=1,K CALL sep_substrings(DESC(I),"-",E1,NE) IF (NE==2) cbt(i)%ref=-VAL(E1(2)) END DO PRINT *,"----------------------------------------------" PRINT *," MBUFR_MAT" PRINT *,"----------------------------------------------" PRINT *,"DESCRIPTORS COLUNS MULT-FACTOR SCALE-REFERENCE" PRINT *,"-----------------------------------------------" do i=1,k write(*,'(i3,">",i6," Col=",i3.3," Mult=",f10.4," Ref=",f10.4)')i,cbt(i)%d,cbt(i)%col,cbt(i)%MULT,cbt(i)%REF END DO !} PRINT *,"----------------------------------------------" ncbtmax=k !} !{ Variaveis globais Valor minimo de corte por centro gerador e por tipo de dado em BUFR minqc(:,:)=60 !................. Minimo Valor de confiabilidade (Controle de qualidade ) !} end subroutine !#==============================================================================# !# MBUFR_SCANMESAGE | SUBROTINA PARA LEITURA E SELECAO DE DADOS BUFR |SHSF # !#------------------------------------------------------------------------------# !# Tipo : SUBROTINA DE ACESSO PUBLICO # !# Dependencias : # !# a) MBUFR (open_mbufr, read_mbufr) # !# b) MFORMAT20 (format_mtabqc, format_tabqc) # !# c) line_thinner # !# # !#------------------------------------------------------------------------------# !# Descricao: # !# Este subrotina processa a leitura de um ou mais arquivos BUFR, extrai as # !# variaveis de interesse definadas em cbt armazenando-as em obs(:,:) # !# # !# Para fazer a leitura de todas as mensagens BUFR dentro de um arquivo # !# BUFR e utilizada a sub-rotina READ_MBUFR sucessivamente. # !# A cada chamada de READ_mbufr, uma nova mensagem e lida e o conteudo completo# !# desta mensagem sao retornados em sec1, sec3 e sec4 # !# # !# Como apenas parte das variaveis sao utilizadas, as subrotinas de MFORMAT # !# processam a selecao das variaveis BUFR (definidas em b_desc, armazenando-as # !# na matriz de observacoes OBS. # !# A cada nova mensagem , os dados sao anexados em OBS e o conteudo de # !# sec3 e sec4 dealocados # !# # !# # !# Caso os dados seja do tipo 3 (ATOVS) e feito um processamento de diluicao # !# Aleatoria, que a cada 4 sondagens, seleciona-se 3 (elimina-se 1 ) # !# # !# Ao final do processo OBS contera todas os dados disponiveis e nrows o # !# numero de linas de dados em OBS # !# # !# Alem destes valores, sao retornados para cada linha de dados em OBS # !# center(1:nrows) - Codigo do centro gerador # !# btype (1:nrows) - Tipo da observacao BUFR (Conforme tabela BUFR A) # !# bsubtype(1:nrows)- Subtipo da observacao BUFR # !# ks(1:nrows) - Numero sequencial que indica uma sondagem ou observacao# !******************************************************************************** subroutine mbufr_scanmessage(un,btype,bsubtype,center,obs,ks,nrows,nobs_qcexc,err) !{ declaracao de variaveis de interface integer,intent(in):: un !....................................Unidade de leitura integer,intent(out):: btype !..............Matriz com os tipo BUFR da observacao integer,intent(out):: bsubtype !...........Matriz com subtipo BUFR da obsercacao integer,intent(out):: center !.......Matriz com os codigos dos centros geradores real,dimension(:,:),intent(out):: obs !....................Matriz de observacoes integer,dimension(:),intent(out)::ks !.Vetor que identifica o numero da sondagem integer,intent(inout):: nrows !.....................Numero de observacoes em obs integer,intent(out)::nobs_qcexc !.Numero de observacoes excluidas por baixa confiabilidade integer :: err !} !{ Declaracao das variaveis utilizadas em read_mbufr type(sec1type)::sec1 type(sec3type)::sec3 type(sec4type)::sec4 integer :: BUFR_ED integer :: MBYTES integer :: nqcexc integer:: iun integer :: i !} !{ declaracao de variaveis locais integer :: nrows0 !....................Linha Inicial dos dados de uma mensagem integer :: nbufr_obsmax !..................Numero maximo de observacoes em BUFR integer :: nrows_thinned !........................... Numero de Linhas diluidas real*8::sec1jdate !.........Variavel auxliar p/ Data juliana da secao 1 do BUFR integer:: minqc2 !...........Variavel auxiliar minimos do controle de qualidade !} !{ Inicializacao de variaveis nbufr_obsmax=ubound(ks,1) nrows_thinned=0 iun=un !} ! Abaixo sao realizados os seguintes passoes: ! ! c)Dentro de cada mensagem processa cada um dos subsets de dados ! d)Os subsets sao organizados em linhas de dados (nrows) ! e)Conforme o caso uma observacao pode ter uma ou mais linhas ! f) KS contem um numero sequencial que indentifica a observacao !{ Call READ_MBUFR(iun, 3000,sec1,sec3,sec4,bUFR_ED,MBYTES,err,select) ! Se nao houver erro de leitura ou se nao tiver chegado ao final do arquivo ! processa a separacao das variaveis meteorologicas de interesse, ! guardando-as na matriz de variaveis B !{ !{ Obtem a data juliana da secao 1 ! caso nao esteja ma faixa, entao ignora os dados sec1jdate=fjulian(sec1%year,sec1%month,sec1%day,sec1%hour,0,0) if (sec1jdate==0) sec1jdate=date1 If ((sec3%ndesc>0).and.(ioerr(iun)==0)) Then if (err/=0) then write(15,'(" Erro =",i3," in Bufrtype =",i3)')err,sec1%btype elseif (((sec1jdate>=date1).and.(sec1jdate<=date2))) then minqc2=minqc(sec1%center,sec1%btype) nrows0=nrows ! Caso seja dados do tipo multinivel, Organiza os dados com ! format_mtabqc. Caso seja de niveis simples, use format_tabqc if ((sec1%btype==2).or.(sec1%btype==3)) then call format_mtabqc(sec4,sec3%nsubsets,minqc2,cbt,ncbtmax,nrows,obs,ks,nqcexc,err) else call format_tabqc(sec4,sec3%nsubsets,minqc2,cbt,ncbtmax,nrows,obs,nqcexc,err) do i=nrows0,nrows;ks(i+1)=i+1;end do end if else err=2 ! Dados fora da janela de tempo ou dados com erro end if else err=1 ! erro na secao 3 ou fim de arquivo end if btype=sec1%btype bsubtype=sec1%bsubtype center=sec1%center nobs_qcexc=nqcexc DEallocate(sec4%r,sec4%d,sec4%c,sec3%d) end subroutine subroutine mbufr_unlink(un) integer,intent(inout)::un call close_mbufr(un) deallocate(cbt) end subroutine end module