program demo6


USE MBUFR
USE MGRADS
USE DATELIB
USE STRINGFLIB
USE MFORMATS


implicit none

!{DECLARACAO DE VARIAVEIS

  

!{ Declaracao das variaveis utilizadas em read_mbufr 
  
	type(sec1type)::sec1
	type(sec3type)::sec3                         
	type(sec4type)::sec4
	integer :: NBYTES,BUFR_ED         
	integer :: err
	!Real,parameter	:: Null=-340282300      !valor nulo 
	type(selecttype),dimension(2)::select

  

!} 



  !{ Declaracao das variaveis utilizadas no mgrads
 
      real*8 :: cdate                                       !Data juliana
      character(len=5),dimension(6)::codes                  !Codigo das variaveis
      character(len=60),dimension(6)::desc                  !Descricao das variaveis
      integer  ::nvarsgrd                                   !Numero das Variaveis
      type(stidtype),dimension(20000)::STID                !Identificacao da estacao   
      real,dimension(20000,6)::gr_obs                         !Matriz com as observacoes
      integer ::nobs                                        !Numero de observacoes     

  !}

  !{ Declara�o das variaveis do MFORMAT
	    integer::ncols ! Numero de colunas de obs
		integer::nrows ! Numero de linha  de obs
		integer,dimension(10)::surf_cols ! Indentifica�o das colunas da matris OBS
		real,dimension(20000,10):: obs ! Matris de observacoes
      
  !}

  !{ Declara�o das variaveis do programa

      integer::nm   ! Contador de nmero de mensagens BUFR
	  character(len=255)::infile  ! Arquivo BUFR de entrada
	  character(len=255)::outfile ! Arquivo Grads (saida)
	  integer::i
	  real :: dir,vel
  !}
  
!} 

!{ INICIO DO PROGRAMA  
    nm=0
    NBYTES = 0
    nrows=0
	select(1)%btype=0
	select(1)%bsubtype=any
    select(2)%btype=1
    select(2)%bsubtype=any
    
  !{ Declaracao das variaveis que serao extraidas do BUFR
 

   surf_cols(1)=005001 ! Latitude (baixa acuracia)
   surf_cols(2)=005002 ! Latitude (alta acuracia)
   surf_cols(3)=006001 ! Longitude (baixa acuracia)
   surf_cols(4)=006002 ! Longitude (alta acuracia)
   surf_cols(5)=007001 ! Altura da estacao 
   surf_cols(6)=010051 ! Pressao reduzida a nivel medio do mar 
   surf_cols(7)=012004 ! Temperatura do ar
   surf_cols(8)=012006 ! Temperatura do ponto de orvalho
   surf_cols(9)=011011 ! Direcao do vento a 10 metros
   surf_cols(10)=011012 ! Velocidade do vento a 10 metros
   ncols=ubound(surf_cols,1) ! Numero de colunas	
     
   obs(:,:)=null
   gr_obs(:,:)=null
    
  !{Abre arquivos BUFR
    
	print *,"Programa demostrativo de conversao de dados BUFR para Grads"
    write(*,'(1x,a,\)')"Informe nome do arquivo BUFR: "
	read(*,'(a)')infile
    outfile=trim(infile)//".grd"

	print *,""
	print *,"Convertendo"
	print *,trim(infile),"->",trim(outfile)
	print *,""

    Call OPEN_MBUFR(1, infile,46,12,0)  
    
 
10    CONTINUE        
      
     
	  call READ_MBUFR(1, 2000,sec1,sec3,sec4, bUFR_ED, NBYTES,err,select)
      
  
	  If ((NBYTES > 0).and.(IOERR(1)==0)) Then 
		 
		IF ((ERR==0).and.(sec4%nvars>0)) THEN 
		
		nm=nm+1
		call format_tab(sec4,sec3%nsubsets,surf_cols,ncols,nrows,obs)
		write(*,'(a,\)')"."
		END IF
		deallocate(sec3%d,sec4%d,sec4%r,sec4%c)	
		GoTo 10		
    
	  end if	
 
    Close (1)

 !} Fim da leitura de todos os arquivos da lista 
   print *,"Numero de mensagens=",nm
   print *,"Numero de observacoes=",nrows
 !{ Salvar dados no formato do grads  
 !{ Iniciar variaveis do grads
 
 333 continue  


 !}
 !{ Obtendo data e hora para grads
 !------------------------------------------------------
 !  Por facilidade pegamos a data e hora da secao 1
 !  para representar todos os dados.
 !
 !  Para completar o codigo da estacao no formato
 !  do grads, utilizamos o tipo e subtipo do BUFR 
 !
 !  A data e hora real dos dados pode ser diferente da
 !  data e hora da secao 1
 !------------------------------------------------------
    cdate=fjulian(sec1%year,sec1%month,sec1%day,sec1%hour,sec1%minute,0)
    print *,"Data=",grdate(cdate)
    print *,"Numero de dados =",nrows

      codes(1)="h"; desc(1)="Altura da Estacao (m)"
      codes(2)="P"; desc(2)="Pressure (hPa)"   
      codes(3)="T"; desc(3)="Temperature (C)"
      codes(4)="Td";desc(4)="Dew Point (C)"
      codes(5)="u"; desc(5)="Surface (10m) zonal wind (m/s)"
      codes(6)="v"; desc(6)="Surface (10m) meridional wind (m/s)"
      nvarsgrd=ubound(codes,1) 

	do i=1,nrows
	    
	   write(STID(I)%COD,'(i4.4,i4.4)')SEC1%BTYPE,SEC1%bsubtype
           !
	   !  Verifica se a latitude e logitude e de baixa o alta acuracia 
           !  e usa  a que vier
	   !
	    if (obs(i,1)==null) then
		   STID(I)%lat=obs(i,2)
		else
		   STID(I)%lat=obs(i,1)
		end if

		if (obs(i,3)==null) then
		   STID(I)%lon=obs(i,4)
		else
		   STID(I)%lon=obs(i,3)
		end if
		
	 !
	 !    Pega a altitude, pressa e temperatura, convertendo para as 
	 !    unidade mais apropriadas
	 !	
		if (obs(i,5)/=null) gr_obs(i,1)=obs(i,5)
		if (obs(i,6)/=null) gr_obs(i,2)=obs(i,6)/100 ! Converte para (hPA)
		if (obs(i,7)/=null) gr_obs(i,3)=obs(i,7)-273.2 ! Converte para Celcius
		if (obs(i,8)/=null) gr_obs(i,4)=obs(i,8)-273.2 ! Converte para Celcius
	!
	! converte direcao e velicidade para componentes U e V do vento
	!
		dir=obs(i,9)
		vel=obs(i,10)
		if ((dir/=null).and.(vel/=null)) then 
                gr_obs(i,5)=-vel*sin(dir*3.141596/180) 
                gr_obs(i,6)=-vel*cos(dir*3.141596/180)
		end if

		!write(*,'(8(1x,f10.2))')STID(I)%lat,STID(I)%LON,gr_obs(i,:)
		

	end do 

 !{ Grava os arquivos de dados (bin) e o descritores (ctl) 
 

    call SAVECTL(2,outfile,cdate,codes,desc,nvarsgrd)
    call SAVEBIN(2,outfile,gr_obs,nrows,STID,nvarsgrd)
    
  !}
  
End