!** 
!   MODULE MGRADS
!
!   MODULO PARA GRAVACAO DE DADOS NO FORMATO DO GRAADS 
!   NO GRADS
!
!   
!   ROTINAS PUBLICAS
!
!     GRAVA_GRADS - grava uma linha de dados binarios do grads
!     GRAVA_GRADSCTL - grava o aquivo descritor (ctl) de um aquivo do grads
!
!   ROTINAS  PRIVATIVAS 
!      
! *   



MODULE MGRADS



 USE DATELIB
 USE stringflib 

 implicit none

type stidtype
   character(len=8):: cod
   real::lat
   real::lon
end type  

 
 
 PUBLIC SAVECTL

 
 CONTAINS
 
!_____________________________________________________ 
 SUBROUTINE SAVECTL(un,filename,cdate,codes,desc,nvars)
      integer,intent(in):: un
      character(len=*),intent(in)::filename
      real*8,intent(in):: cdate
      character(len=*),dimension(:),intent(in)::codes ! Codigo das variaveis
      character(len=*),dimension(:),intent(in)::desc  ! Descricao das variaveis
      integer,intent(in)::nvars                       ! Numero das Variaveis

 
 !{ Variaveis locais 
	Character(len=255)::ctlname,filename2
	integer ::i,uni
        character(len=255)::gradsdate
	character(len=50),dimension(50)::substring
	integer ::nelements
!}

!{ Iniciar variaveis Locais
	print*,"aqui" 
	uni=un
	i=0
        ctlname=trim(filename)//'.ctl'
!}	

!{ Cortar os diretorios do nome do arquivo
       call sep_substrings(filename,'/',substring,nelements)
       filename2=substring(nelements)
!} 

!{ Gravar arquivo descritor (CTL)
	open(uni,file=ctlname,status='unknown')
       
	write(uni,1001)trim(filename2)    
   1001 format('DSET ^',a,'.bin')
          
	    write(uni,1002)    
   1002 format('DTYPE station')
   
        write(uni,1003)trim(filename2)    
   1003 format('STNMAP ^',a,'.map')
    
        write(uni,1004) null
   1004 format('UNDEF ',f12.1)
   
        write(uni,1005)
   1005 format('TITLE INPE-CPTEC')

        gradsdate=grdate(cdate)
        write(uni,1006) trim(gradsdate)
   1006 format('TDEF 1 linear ',a,' 3hr')
   
        write(uni,1007)nvars
   1007 format('VARS ',i3)

        do i=1,nvars
          write(uni,'(a4,a5,1x,a30)')codes(i)," 0 99 ",desc(i)
        end do

        write(uni,'(a)')"ENDVARS"
!}
   close(uni)
 
 end subroutine  SAVECTL


!______________________________________________________
SUBROUTINE SAVEBIN(un,filename,obs,nobs,STID,nvars)
 
	    
	
! SAVEBIN : Grava arquivos Binários do Grads		
	
	
	integer,intent(in)::un
        character(len=*),intent(in)::filename
        type(stidtype),dimension(:),intent(inout)::STID  
        real,dimension(:,:),intent(INOUT)::obs
        integer,intent(in)::nobs
        integer,intent(in)::nvars
        integer ::irec

!{ Variaveis Locais


	Integer*4:: NFLAG,NLEV,i,uni,j,ub
	REAL::TIM,rlat,rlon
	character(len=255)::outfile
        character(len=8)::C
        character(len=4)::C1,C2
!}


!{ Iniciando Variaveis Locais 
	NFLAG = 1
	NLEV = 1
	TIM=0.0
        uni=un
        outfile=trim(filename)//".bin"
!}      
  
!{ Verificar se o tamanho da matriz/ nobs esta correto
      ub=ubound(obs,1)
      if (ub<nobs) then 
        Print *,"Erro em mgrads:"
        print *," nobs ou obs com tamanho incorretos"
        print *," nobs =",nobs
        print *," tamanho(nobs)=",ub
        stop
      end if

!}
!{ Grava arquivo Binário  

  
       open(uni,file=outfile,STATUS='unknown',FORM='UNFORMATTED',access='DIRECT',recl=4) 
        irec=0
        print *,nobs
        Do i=1,nobs
          C=STID(i)%COD
          C1=C(1:4)
          C2=C(5:8)
          irec=irec+1;WRITE (uni,rec=irec)C1
          irec=irec+1;WRITE (uni,rec=irec)C2
          irec=irec+1;WRITE (uni,rec=irec)STID(i)%Lat
          irec=irec+1;WRITE (uni,rec=irec)STID(i)%LON
          irec=irec+1;WRITE (uni,rec=irec)TIM
	  irec=irec+1;WRITE (uni,rec=irec)NLEV
          irec=irec+1;WRITE (uni,rec=irec)NFLAG
	  DO J=1,NVARS
            irec=irec+1
            WRITE (uni,rec=irec) OBS(I,J)
          END DO
         End do	

	rlat=0.0
	rlon=0.0
	TIM=0.0
	NLEV=0
	NFLAG=1
	irec=irec+1;WRITE (uni,rec=irec) C1
        irec=irec+1;WRITE (uni,rec=irec) C2
        irec=irec+1;WRITE (uni,rec=irec) rLat
        irec=irec+1;WRITE (uni,rec=irec) rLon
        irec=irec+1;WRITE (uni,rec=irec) TIM
        irec=irec+1;WRITE (uni,rec=irec) NLEV
        irec=irec+1;WRITE (uni,rec=irec) NFLAG
        close(uni)
        print *,trim(outfile)," ",irec*4," Bytes Gravados"

!}
	
END SUBROUTINE SAVEBIN


 
 
END MODULE