!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!BOI
!
! !TITLE: Input/Output BAM interface Documentation \\ Version 1.0.0
!
! !AUTHORS: João Gerd Zell de Mattos
!
! !AFFILIATION: Modeling and Development Division, CPTEC/INPE
!
! !DATE: October 11, 2016
!
! !INTRODUCTION:
!      Input/Output BAM interface (sigio\_BAMMod) is a Fortran 90 collection of 
!      routines/functions for accessing the forecasting data files of the
!      Brazilian Global Atmospheric Model (BAM) in spectral format.
!
! \subsection{BAM data files}
!
! Os arquivos de previsão do modelo BAM são constituídos por dois arquivos em
! formatos distintos: 
!   \begin{enumerate}
!      \item Um arquivo no formato ASCII, denominado arquivo {\bf dir} contém um 
!            cabeçalho descrevendo algumas informações da simulação, tais
!            como: (a) data inicial e final da simulação, (b) número de níveis
!            verticais e (c) delta Z entre os níveis verticais. Este arquivo também
!            possui uma tabela contendo as variáveis disponíveis no arquivo de
!            previsão, identificando o tipo de cada variável
!            (Diagnostica/Prognóstica), a quantidade de níveis verticais e se é
!            uma variável em ponto de grade ou em formato spectral;
!      \item Um arquivo no formato `IEEE', denominado arquivo {\bf fct} que contém um 
!            cabeçalho com a data da simulacão, seguido pelos campos diagnosticos e 
!            prognosticos do modelo BAM. Estes campos estão na mesma sequência em que 
!            aparecem na tabela de variáveis do aquivo {\bf dir} \\
!            {\bf NOTA:} um arquivo no formato `IEEE' é refenciado como um
!            arquivo fortran não formatado (``unformatted'') com acesso sequencial
!            e com o comprimento dos registros variável. No sistema Linux/Unix comum, é 
!            apenas um arquivo com registros utilizando palavras de 4 bytes e um 
!            ``cabecalho'' de 4 bytes indicando o tamanho do registro em bytes.
!   \end{enumerate}
!   
! \newpage
! \subsection{Principais Rotinas/Funções}
!
! \begin{verbatim}
!  ------------------------+-----------------------------------------
!     Routine/Function     |             Description
!  ------------------------+-----------------------------------------
!                          |
!   BAM_Open               | Open a BAM file
!   BAM_Close              | Close a BAM file
!   BAM_GetField           | Return a BAM field from a file
!   BAM_GetOneDim          | Return just one of 4 BAM field dimensions
!   BAM_GetDims            | Return BAM field dimensions
!   BAM_GetNlevels         | Return the number of leves of a field
!   BAM_GetVerticalCoord   | Return information about vertical coordinate
!   BAM_GetWCoord          | Return BAM world coordinates
!   BAM_GetHeadInfo        | Read BAM fct file header informations
!   BAM_GetTimeInfo        | Return time info
!   BAM_WriteAnlHeader     | Write the Anl file header
!   BAM_WriteField         | Write a BAM field (mpi or serial)
!   BAM_SendField          | if mpi code is used to send a field to write
!                          |
!  ------------------------+-----------------------------------------
! \end{verbatim}
!
! \subsection{Exemplo de uso}
!
! O primeiro passo é carregar este módulo no programa fortran e definir uma estrutura 
! de dados contendo as informações do BAM.
! 
! \begin{enumerate}
!
!    \item Defina no início do programa fortran o uso do módulo sigio\_BAMMod:
!
!    \begin{verbatim}
!       use sigio_BAMMod    
!    \end{verbatim}
!
!    \item Defina uma variável que conterá a estrutura de dados:
!
!    \begin{verbatim}
!       type(BAMFile) :: BAM_struc
!    \end{verbatim}
!
!    \item Defina qual o arquivo deverá ser lido (fct,dir,anl). Os arquivos do bam são
!    compostos por um arquivo de cabecalho (dir) e um arquivo binario (fct/anl):
! 
!    \begin{verbatim}
!      BAM_struct%fdir = GFCTNMC20131231002013123106F.dir.TQ0062L028
!      BAM_struct%ffct = GFCTNMC20131231002013123106F.fct.TQ0062L028
!    \end{verbatim}
! 
!    \item Utilize a rotina específica para a abertura do arquivo:
! 
!    \begin{verbatim}
!  
!       call BAM_Open(BAM_struc, iret)
!   
!    \end{verbatim}
! 
!    \item Faça a leitura do campo disponível no BAM, defina antes o nome da 
!          variável, o nível vertical e aloque um vetor do tamanho necessário para
!          retornar o campo solicitado:
! 
!    \begin{verbatim}
!    
!       Allocate(grid(192*96))
!       
!       VName = `VIRTUAL TEMPERATUE'
!       ilev  = 1
!       
!       call BAM_GetField(BAM_struc, trim(VName(ivar)), ilev, grid, iret)
!   
!    \end{verbatim}
! 
!    \item Depois que forem lidos todos os campos necessários do modelo BAM feche o arquivo:
!    
!    \begin{verbatim}
!        call BAM_Close(BAM_struc)
!    \end{verbatim}
! 
! \end{enumerate}
! 
!Veja os prólogos na próxima seção para obter detalhes adicionais.
!
!EOI
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!
Module sigio_BAMMod

   use MPI
   use Fourier,  only: InitFFT, ClsMemFFT
   use legendre, only: InitLegendre, ClsMemLegendre
   use recomposition, only: InitRecomposition, ClsMemRecomposition, &
                            RecompositionScalar, RecompositionVector, &
                            DivgVorttoUV
   use decomposition, only: InitDecomposition, ClsMemDecomposition,&
                            DectoSpherHarm, UVtoDivgVort, TransSpherHarm

   implicit none
   Private

!
! !PARAMETERS:
!
   !
   !precisao dos dados do modelo BAM
   integer, public, parameter :: I4 = SELECTED_INT_KIND(9)   ! Kind for 32-bits Integer Numbers
   integer, public, parameter :: I8 = SELECTED_INT_KIND(14)  ! Kind for 64-bits Integer Numbers
   integer, public, parameter :: R4 = SELECTED_REAL_KIND(6)  ! Kind for 32-bits Real Numbers
   integer, public, parameter :: R8 = SELECTED_REAL_KIND(15) ! Kind for 64-bits Real Numbers
   integer, public, parameter :: strlen = 1024

   !Logical Units 
   integer, parameter :: stderr = 0 ! Error Unit
   integer, parameter :: stdinp = 5 ! Input Unit
   integer, parameter :: stdout = 6 ! Output Unit


   ! Constants
   real, parameter :: rd = 45_r8/ATAN(1.0_r8) ! convert to radian

   ! MPI Parameters
   integer :: MPITag = 100
   integer :: status(MPI_Status_size)

   ! BAM header structure
   type BAM_head
      character (len = 20) :: ittl
      character (len = 40) :: specal
      character (len = 41) :: jttl
      character (len =  4) :: sdain
      character (len =  4) :: dtin
      character (len =  5) :: trunc
      integer (I4)         :: nexp
      integer (I4)         :: mMax
      integer (I4)         :: mnwv2
      integer (I4)         :: imax
      integer (I4)         :: jmax
      integer (I4)         :: kmax
      integer (I4)         :: ihr, idy, imo, iyr
      integer (I4)         :: fhr, fdy, fmo, fyr

      ! sigma levels
      real (r8), dimension (:), pointer :: delSig
      real (r8), dimension (:), pointer :: SigInt
      real (r8), dimension (:), pointer :: SigMid

      ! lat/lon iformations
      real(r4), dimension(:), pointer :: rlon ! real longitude
      real(r4), dimension(:), pointer :: clon ! rlon cosine
      real(r4), dimension(:), pointer :: slon ! rlon sine
      real(r4), dimension(:), pointer :: rlat ! real latitude
      real(r4), dimension(:), pointer :: clat ! rlat cosine
      real(r4), dimension(:), pointer :: slat ! rlat sine

   end type

   ! BAM fields structure
   type BAM_fld
      character (len = 40)   :: Name  ! Long field Name
      character (len =  4)   :: ProDia! Prognostig / Diagnostic 
      integer (I4)           :: nharm ! variable array size
      integer (I4)           :: nlevs ! variable # of levs
      integer (I4)           :: fldunit
      real (r4), allocatable :: grid(:,:,:)
      type(BAM_fld), pointer :: next => null()
   end type

   ! BAM data type structure
   type, public :: BAMFile
      character(len=strlen)  :: fanl  ! Anl file name
      character(len=strlen)  :: ffct  ! fct file name
      character(len=strlen)  :: fdir  ! dir file name (header informations)
      integer (I4)           :: uanl  ! Anl file opened unit
      integer (I4)           :: ufct  ! fct file opened unit
      integer (I4)           :: udir  ! dir file opened unit
      type(BAM_head)         :: head  ! header informations (see BAM_Head type)
      type(BAM_fld), pointer :: root => null()
      type(BAM_fld), pointer :: flds => null()
      integer (I4)           :: fcount
   end type
!
! !PUBLIC MEMBER FUNCTIONS:
!

   public :: BAM_Open           ! Open a BAM file
   public :: BAM_Close          ! Close a BAM file
   public :: BAM_GetField       ! Read BAM field from a file
   public :: BAM_GetOneDim      ! Return just one of 4 BAM field dimensions
   public :: BAM_GetDims        ! Return BAM field dimensions
   public :: BAM_GetNlevels     ! Return the number of leves of a field
   public :: BAM_GetSigValues
   public :: BAM_GetVerticalCoord
   public :: BAM_GetWCoord      ! Return BAM world coordinates
   public :: BAM_GetHeadInfo    ! Read BAM fct file header informations
   public :: BAM_GetTimeInfo    ! Return time info
   public :: BAM_WriteAnlHeader ! Write the Anl file header
   public :: BAM_WriteField     ! Write a BAM field (mpi or serial)
   public :: BAM_SendField      ! if mpi code is used to send a field to write
   public :: BAM_GetAvailUnit


   interface BAM_GetHeadInfo
      module procedure ReadHead_
   end interface

   interface BAM_GetField
      module procedure  SGetFLD_1d, SGetFLD_2d, &
                        DGetFLD_1d, DGetFLD_2d, &
                        ReadFLDS_
   end interface

   interface ReadField
      module procedure SRead1D_, SRead2D_, SRead3D_, &
                       DRead1D_, DRead2D_, DRead3D_, &
                       SkipRead_
   end interface

   interface BAM_WriteField
      module procedure WriteField_MPI, WriteField_Serial
   end interface

   interface perr
      module procedure perr1_
   end interface

   interface BAM_GetAvailUnit
      module procedure GetAvailUnit
   end interface
   
!
! !REVISION HISTORY:
!
! 	11 Oct 2016 - J. G. Z. de Mattos - Initial Version
!
!-----------------------------------------------------------------------------!


   contains
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_Open - routine used to open BAM type files for read and
!                       write purposes.
!
! 
! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos
!               do modelo BAM. Há dois modos para a abertura dos aquivos do BAM, 
!               um somente leitura e outro para escrita. No modo somente
!               leitura, caso não seja definido explicitamente qual o arquivo
!               que deve ser lido, abre-se por padrão os arquivos necessários
!               para a leitura do arquivo de previsão, ou seja, abre o arquivo
!               DIR e o arquivo FCT. O arquivo DIR serve como um arquivo
!               descritor que indica qual a posicão de cada variável dentro do
!               arquivo FCT. Já no modo de escrita, caso não seja especificado,
!               abre-se somente o arquivo de condicão inicial do BAM. No modo de
!               escrita, caso o arquivo já exista ele é sobrescrito pelo novo
!               arquivo.
!
!
! !INTERFACE:
!
   subroutine BAM_Open(BFile, mode, ftype, istat)

      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile),              intent(inout) :: BFile

      ! Open mode: R - read-only; W - Write
      character(len=*),           intent(in   ) :: mode

      ! File type: dir, fct, anl
      character(len=*), optional, intent(in   ) :: ftype
      ! Can be:
      !        1. dir: descriptor BAM file
      !        2. fct: forecast BAM file
      !        3. anl: initial condition BAM file
      !
      ! At Read-only mode default ftype is to open dir and fct together
      ! At Write mode default ftype is to open anl file only
      !
!
! !OUTPUT PARAMETERS:
!
      integer,          optional, intent(  out) :: istat

!
! !SEE ALSO:
!
!   Open_( ) interface to open each type of BAM file
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: BAM_Open( ... )'

      character(len=1) :: md
      integer          :: iret, iret0, iret1

      integer :: IMax, JMax

      if(present(istat))istat = 0

      md = ucase(mode)

      select case (md)

         case ('R')

            if(present(ftype))then

               call Open_(BFile, mode, ftype, iret)

               if(present(istat))istat = iret

            else

               if(trim(Bfile%ffct).ne.''.and.trim(Bfile%fdir).ne.'')then

#ifdef VERBOSE
                  write(stdout,'(A)')'Opening default BAM file to read: DIR and FCT files'
#endif

                  call Open_(BFile, mode, 'fct', iret0)
                  call Open_(BFile, mode, 'dir', iret1)
                  iret = min(iret0,iret1)
                  if(present(istat))istat = iret

               else

                  write(stdout,'(2(1x,A))')trim(myname_),' error : Undefined ftype, try open default files.'
                  write(stdout,'(   A   )')''
                  write(stdout,'(1(1x,A))')'Default files to read-only open type are DIR and FCT file,'
                  write(stdout,'(1(1x,A))')'but ffct and dir names are undefined!'
                  write(stdout,'(   A   )')''
                  write(stdout,'(1(1x,A))')'use ftype= :'
                  write(stdout,'(1(1x,A))')'   <anl> : to read anl file'
                  write(stdout,'(1(1x,A))')'   <fct> : to read fct file'
                  write(stdout,'(1(1x,A))')'   <dir> : to read dir file'
                  write(stdout,'(   A   )')''
                  write(stdout,'(1(1x,A))')'define file name:'
                  write(stdout,'(1(1x,A))')'   <fanl> : Name of anl file'
                  write(stdout,'(1(1x,A))')'   <ffct> : Name of fct file'
                  write(stdout,'(1(1x,A))')'   <fdir> : Name of dir file'

                  if(present(istat))istat = -1

               endif

            endif

         case ('W')

            if(present(ftype))then

               call Open_(BFile, mode, ftype, iret)
               if(present(istat))istat = iret

            else

               if(trim(Bfile%fanl).ne.'')then

#ifdef VERBOSE
                  write(stdout,'(A)')'Opening default BAM file to write: ANL file'
#endif
                  call Open_(BFile, mode, 'anl', iret)
                  if(present(istat))istat = iret

               else

                  write(stdout,'(2(1x,A))')trim(myname_),' error : Undefined ftype, try open default files.'
                  write(stdout,'(   A   )')''
                  write(stdout,'(1(1x,A))')'Default files to write open type is ANL file,'
                  write(stdout,'(1(1x,A))')'but anl file name is undefined!'
                  write(stdout,'(   A   )')''
                  write(stdout,'(1(1x,A))')'use ftype= :'
                  write(stdout,'(1(1x,A))')'   <anl> : to write anl file'
                  write(stdout,'(1(1x,A))')'   <fct> : to write fct file'
                  write(stdout,'(1(1x,A))')'   <dir> : to write dir file'
                  write(stdout,'(   A   )')''
                  write(stdout,'(1(1x,A))')'define file name:'
                  write(stdout,'(1(1x,A))')'   <fanl> : Name of anl file'
                  write(stdout,'(1(1x,A))')'   <ffct> : Name of fct file'
                  write(stdout,'(1(1x,A))')'   <fdir> : Name of dir file'

                  if(present(istat))istat = -1

               endif

            endif

         case default

            write(*,'(3(1x,A))')trim(myname_),': Unknown mode type:',trim(mode)
            write(*,'(2(1x,A))')trim(myname_),': use <w/W> for write and <r/R> for read'
            if(present(istat))istat = -1

      end select

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: Open_ - routine that call low level routines to open each type 
!                    of BAM files
!
! 
! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos
!               do modelo BAM. Há dois modos para a abertura dos aquivos do BAM: 
!               (1) somente leitura e (2) escrita. Em ambos os casos é
!               necessário informar qual o tipo do arquivo que se está querendo
!               ler ou escrever. Há três tipos de dados: (1) arquivos de
!               previsão (FCT), (2) arquivos de condicão inicial (ANL) e (3) arquivos
!               descritores (DIR). O arquivo DIR serve como um arquivo
!               descritor que indica qual a posicão de cada variável dentro do
!               arquivo FCT. É importante salientar que no modo de escrita, 
!               caso o arquivo já exista ele é sobrescrito pelo novo arquivo.
!
!
! !INTERFACE:
!

   subroutine Open_(BFile, mode, ftype, istat)

      USE InputParameters, ONLY: InitParameters,   &
                                 Imax, Jmax, Kmax, &
                                 mnwv2, Mend,      &
                                 flon, flat
      implicit none
!
! !INPUT PARAMETERS:
!

      ! BAM file structure
      type(BAMFile),     intent(inout) :: BFile
      
      ! Open mode: R - read-only; W - Write
      character(len=*),  intent(in   ) :: mode
      
      ! File type: dir, fct, anl
      character(len=*),  intent(in   ) :: ftype
      ! Can be:
      !        1. dir: descriptor BAM file
      !        2. fct: forecast BAM file
      !        3. anl: initial condition BAM file
      !
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!   OpenAnl_( ) interface to open ANL BAM file
!   OpenFCT_( ) interface to open FCT BAM file
!   OpenDIR_( ) interface to open DIR BAM file
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!

      character(len=*), parameter :: myname_ = 'Open_( ... )'
      integer :: iret
      character(len=1024) :: ftype_name
      character(len=1024) :: ftype_mode

      if(present(istat))istat = 0
      
      ftype_name = ucase(ftype)
      ftype_mode = ucase(mode)

      select case(trim(ftype_name))

         case('ANL')! BAM anl file

            call OpenAnl_( BFile, trim(ftype_mode), iret)
            if (iret .ne. 0 )then
               if(present(istat)) istat = iret
               return
            endif

         case('FCT')! BAM fct file

            call OpenFct_( BFile, trim(ftype_mode), iret)
            if (iret .ne. 0 )then
               if(present(istat)) istat = iret
               return
            endif

         case('DIR')! BAM dir file

            call OpenDir_( BFile, trim(ftype_mode), iret)
            if (iret .ne. 0 )then
               if(present(istat)) istat = iret
               return
            endif

            call ReadHead_(BFile,iret)

            if (iret .ne. 0)then
               write(6,'(A,1x,A,I3)')trim(myname_),' error to get Header of BAM file', iret
               if(present(istat))istat = iret
               return
            endif

      end select

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: OpenAnl_ - routine that call low level routines to open ANL type 
!                    of BAM files
!
! 
! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos
!               de análise do modelo BAM. Há dois modos para a abertura dos aquivos: 
!               (1) somente leitura e (2) escrita.  É importante salientar que no 
!               modo de escrita, caso o arquivo já exista ele é sobrescrito pelo 
!               novo arquivo.
!
!
! !INTERFACE:
!

   subroutine OpenAnl_( BFile, mode, istat )
      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile),     intent(inout)  :: BFile
      
      ! Open mode: R - read-only; W - Write
      character(len=*),  intent(in   )  :: mode
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out)  :: istat
      !
      ! -80 : File not found
      !


! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter :: myname_ = 'OpenAnl_ ( ... )'

      logical          :: existe
      integer          :: iret
      character(len=1) :: md

#ifdef DEBUG
      WRITE(stdout,'(     2A)')'Hello from ', trim(myname_)
#endif

      if(present(istat))istat=0


      inquire(file=trim(BFile%fanl),exist=existe)

      md = ucase(mode)
      select case (trim(md))

         case ('R')

            if(.not.existe)then
               iret = -80
               write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),&
                                       'Model file not found : '//trim(BFile%fanl)
               if(present(istat))istat=iret
               return
            endif

            !Get next available logical unit
            BFile%uanl = BAM_GetAvailUnit(  )

            open( unit   = BFile%uanl,         &
                  file   = trim(BFile%fanl),   &
                  status = 'unknown',          &
                  form   = 'unformatted',      &
                  action = 'read',             &
                  iostat = iret                &
                )

         case ('W')

            if(existe)then
               write(6,'(A,1x,A,1x,A)')'BAM warning =>',trim(myname_),&
                                       'Model File Already Exists : '//trim(BFile%fanl)
               write(6,'(A)')'Overwriting existing file!'
            endif
            
            !Get next available logical unit
            BFile%uanl = BAM_GetAvailUnit(  )

            open( unit   = BFile%uanl,         &
                  file   = trim(BFile%fanl),   &
                  status = 'unknown',          &
                  form   = 'unformatted',      &
                  action = 'write',            &
                  iostat = iret                &
                )

      end select

      if (iret.ne.0)then
         write(6,'(A,1x,A,1x,A,1x,I3)')'BAM error =>',trim(myname_),&
                                       'Error to open model file: '//trim(BFile%fanl),iret
         if(present(istat))istat=iret
         return
      endif

   endsubroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: OpenFct_ - routine that call low level routines to open FCT type 
!                    of BAM files
!
! 
! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos
!               de previsão do modelo BAM. Há dois modos para a abertura dos aquivos: 
!               (1) somente leitura e (2) escrita.  É importante salientar que no 
!               modo de escrita, caso o arquivo já exista ele é sobrescrito pelo 
!               novo arquivo.
!
!
! !INTERFACE:
!

   subroutine OpenFct_( BFile, mode, istat )
      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile),     intent(inout)  :: BFile
      
      ! Open mode: R - read-only; W - Write
      character(len=*),  intent(in   )  :: mode
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out)  :: istat
      !
      ! -80 : File not found
      !

! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter :: myname_ = 'OpenFct_( ... )'

      logical          :: existe
      integer          :: iret
      character(len=1) :: md

#ifdef DEBUG
      WRITE(stdout,'(     2A)')'Hello from ', trim(myname_)
#endif

      if(present(istat)) istat = 0

      inquire(file=trim(BFile%ffct),exist=existe)

      md = ucase(mode)
      select case (trim(md))

         case ('R')

            if(.not.existe)then
               iret = -80
               write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),&
                                       'Model file not found : '//trim(BFile%ffct)
               if(present(istat))istat=iret
               return
            endif

            !Get next available logical unit
            BFile%ufct = BAM_GetAvailUnit(  )

            open( unit   = BFile%ufct,         &
                  file   = trim(BFile%ffct),   &
                  status = 'old',              &
                  form   = 'unformatted',      &
                  action = 'read',             &
                  iostat = iret                &
                )

         case ('W')

            if(existe)then
               write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),&
                                       'Model File Already Exists : '//trim(BFile%ffct)
               write(6,'(A)')'Overwriting existing file!'
            endif

            !Get next available logical unit
            BFile%ufct = BAM_GetAvailUnit(  )

            open( unit   = BFile%ufct,         &
                  file   = trim(BFile%ffct),   &
                  status = 'new',              &
                  form   = 'unformatted',      &
                  action = 'write',            &
                  iostat = iret                &
                )

      end select

      if (iret.ne.0)then
         write(6,'(A,1x,A,1x,A,1x,I3)')'BAM error =>',trim(myname_),&
                                       'Error to open model file: '//trim(BFile%ffct),iret
         if(present(istat))istat=iret
         return
      endif

   endsubroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: OpenDir_ - routine that call low level routines to open DIR type 
!                    of BAM files
!
! 
! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos
!               descritores (DIR) do modelo BAM. Há dois modos para a abertura 
!               dos aquivos: (1) somente leitura e (2) escrita.  É importante 
!               salientar que no modo de escrita, caso o arquivo já exista ele
!               é sobrescrito pelo novo arquivo.
!
!
! !INTERFACE:
!

   subroutine OpenDir_( BFile, mode, istat )
      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile),     intent(inout)  :: BFile
      
      ! Open mode: R - read-only; W - Write
      character(len=*),  intent(in   )  :: mode
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out)  :: istat
      !
      ! -80 : File not found
      !

! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter :: myname_ = 'OpenDir_( ... )'

      logical          :: existe
      integer          :: iret
      character(len=1) :: md

#ifdef DEBUG
      WRITE(stdout,'(     2A)')'Hello from ', trim(myname_)
#endif

      if(present(istat)) istat = 0


      inquire(file=trim(BFile%fdir),exist=existe)

      md = ucase(mode)
      select case (trim(md))

         case ('R')

            if(.not.existe)then
               iret = -80
               write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),&
                                       'Model file not found : '//trim(BFile%fdir)
               if(present(istat))istat=iret
               return
            endif

            !Get next available logical unit
            BFile%udir = BAM_GetAvailUnit(  )

            open(unit   = BFile%udir,        &
                 file   = trim(BFile%fdir),  &
                 status = 'old',             &
                 action = 'read',            &
                 form   = 'formatted',       &
                 iostat = iret               &
                )

         case ('W')

            if(existe)then
               write(6,'(A,1x,A,1x,A)')'BAM error =>',trim(myname_),&
                                       'Model File Already Exists : '//trim(BFile%fdir)
               write(6,'(A)')'Overwriting existing file!'
            endif

            !Get next available logical unit
            BFile%udir = BAM_GetAvailUnit(  )

            open(unit   = BFile%udir,        &
                 file   = trim(BFile%fdir),  &
                 status = 'new',             &
                 action = 'write',           &
                 form   = 'formatted',       &
                 iostat = iret               &
                )

      end select

      if (iret.ne.0)then
         write(6,'(A,1x,A,1x,A,1x,I3)')'BAM error =>',trim(myname_),&
                                       'Error to open model file: '//trim(BFile%fdir),iret
         if(present(istat))istat=iret
         return
      endif

   endsubroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: ReadHead_ - routine that read informations from dir file and
!                        initialize all BAM structure used to read and write BAM
!                        files.
!
! 
! !DESCRIPTION: Esta rotina lê as informacões contidas no arquivo descritor do
!               modelo BAM (arquivo DIR) e então inicializa a estrutura de dados
!               (BAMFile) usada neste módulo para ler e escrever os arquivos do
!               BAM.
!
!
! !INTERFACE:
!

   subroutine ReadHead_(BFile, istat )
   
      USE InputParameters, ONLY: InitParameters, &
                                 Imax, Jmax, kmax, &
                                 mnwv2, Mend, &
                                 flon, flat
      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile), intent(inout)   :: BFile

!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(out) :: istat
!
! !SEE ALSO:
!
!     setsig( ) - calcula niveis sigma
!     InitParameters( ) - Inicializa algumas informacoes do modelo BAM
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter :: myname_ = 'ReadHead_( ... )'


      integer :: k
      integer :: iret
      integer :: ilev, isum

#ifdef DEBUG
      WRITE(stdout,'(     2A)')'Hello from ', trim(myname_)
#endif

      rewind(BFile%udir)

      read (BFile%udir,'(A20)') BFile%head%ittl
      read (BFile%udir,'(A4,1X,A4,1X,A5,1X,11I5,1X,A4)') &
                        BFile%head%nexp, BFile%head%sdain, BFile%head%trunc, &
                        BFile%head%mMax, BFile%head%kmax, BFile%head%kmax, &
                        BFile%head%fhr, BFile%head%fdy, BFile%head%fmo, BFile%head%fyr, &
                        BFile%head%ihr, BFile%head%imo, BFile%head%idy, BFile%head%iyr, &
                        BFile%head%dtin

      read (BFile%udir,'(2A41)') BFile%head%jttl, BFile%head%specal

      allocate(BFile%head%delSig(BFile%head%kmax))

!--------------------------------------------------------------------------------------!
!
!      read (BFile%udir,'(5E16.8)') (BFile%head%delSig(k),k=1,BFile%head%kmax)

      ilev = 5
      isum = 0
      do while(isum .le. BFile%head%kmax)
         ilev = min(ilev, (BFile%head%kmax-isum))
         READ (BFile%udir,*) (BFile%head%delSig(k+isum),k=1,ilev)
         isum = isum + 5
      enddo
!--------------------------------------------------------------------------------------!

      allocate(BFile%head%SigMid(BFile%head%kmax))
      allocate(BFile%head%SigInt(BFile%head%kmax+1))


      call setsig(&
                  BFile%head%SigInt, & ! sigma value at each interface.
                  BFile%head%SigMid, & ! sigma value at midpoint of each layer
                  BFile%head%DelSig  & ! sigma spacing for each layer.
                 )

      allocate(BFile%root)

      BFile%flds => BFile%root
      BFile%fcount = 0
      do
         read (BFile%udir,'(A40,2X,A4,2X,I8,3X,I4,4X,I3)',&
               END=35,ERR=34,iostat=iret)           &
                                         BFile%flds%Name,   &
                                         BFile%flds%ProDia, &
                                         BFile%flds%nharm,  &
                                         BFile%flds%nlevs,  &
                                         BFile%flds%fldunit
         allocate(BFile%flds%next)
         BFile%flds => BFile%flds%next

         BFile%fcount = BFile%fcount + 1
      enddo

34    write(*,'(A)') '!!! wrong header file '//trim(BFile%fdir),iret
      if(present(istat))then
         istat = iret
         return
      endif

35    continue

      !
      ! Init Grid and Spectral parameters
      !

      CALL InitParameters (BFile%head%mMax-1)

      BFile%head%IMax  = Imax
      BFile%head%JMax  = Jmax
      !KMax was read from Header
      BFile%head%mnwv2 = mnwv2

      !
      ! Lat/Lon informations
      !

      allocate(BFile%head%rlat(JMax))
      allocate(BFile%head%clat(JMax))
      allocate(BFile%head%slat(JMax))

      BFile%head%rlat ( JMax:1:-1 ) = flat( 1:JMax )
      BFile%head%clat ( JMax:1:-1 ) = cos( flat( 1:JMax ) / rd )
      BFile%head%slat ( JMax:1:-1 ) = sin( flat( 1:JMax ) / rd )

      allocate(BFile%head%rlon(IMax))
      allocate(BFile%head%clon(IMax))
      allocate(BFile%head%slon(IMax))

      BFile%head%rlon ( 1:IMax ) = flon( 1:IMax )
      BFile%head%clon ( 1:IMax ) = cos( flon( 1:IMax ) / rd )
      BFile%head%slon ( 1:IMax ) = sin( flon( 1:IMax ) / rd )


      return 

40    write (*, '(A)') &
              ' Unexpected End of File in Input File Directory.'
      stop 4100

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_Close_ - routine that close all BAM files opened and reset all
!                         informations in BAMFile structure.
!
! 
! !DESCRIPTION: Esta rotina fecha todos os arquivos do BAM (ANL, FCT, DIR) que
!               estejam abertos e também reinicia todas as informacões contidas
!               na estrutura de dados BAMFile.
!
!
! !INTERFACE:
!

   subroutine BAM_Close(BFile, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(inout) :: BFile
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out) :: istat
! !SEE ALSO:
!
!   ResetHead_( ) reset all information from BAMFile structure
!
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: BAM_Close( ... )'

      type(BAM_fld), pointer :: tmp => null()
      integer       :: iret
      logical       :: isopen

      if(present(istat)) istat = 0

      !
      ! close ANL file if is opened
      !
      inquire(BFile%uanl, opened=isopen)
      if(isopen) then 
         close(BFile%uanl, STATUS='KEEP', iostat=iret)
         if(iret.ne.0)then
            write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%fanl)
            if(present(istat)) istat = iret
         endif
         BFile%uanl = -1
         BFile%fanl = ''
      endif

      !
      ! close FCT file if is opened
      !
      inquire(BFile%ufct, opened=isopen)
      if(isopen) then 
         close(BFile%ufct, STATUS='KEEP', iostat=iret)
         if(iret.ne.0)then
            write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%ffct)
            if(present(istat)) istat = iret
         endif
         BFile%ufct = -1
         BFile%ffct = ''
      endif

      !
      ! close DIR file if is opened
      !
      inquire(BFile%udir, opened=isopen)
      if(isopen) then 
         close(BFile%udir, STATUS='KEEP', iostat=iret)
         if(iret.ne.0)then
            write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%fdir)
            if(present(istat)) istat = iret
         endif

         BFile%udir = -1
         BFile%fdir = ''

         !
         ! reset all header data
         !

         call ResetHead_(BFile)

         !
         ! reset vartable
         !

         BFile%fcount = -1

         tmp => BFile%root%next
         do
            deallocate(BFile%root)
            if(.not.associated(tmp)) exit
            BFile%root => tmp
            tmp => tmp%next         
         enddo

      endif

      return

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: ResetHead_ - routine that reset all informations in BAMFile 
!                         structure.
!
! 
! !DESCRIPTION: Esta rotina reinicia todas as informacões contidas
!               na estrutura de dados BAMFile.
!
!
! !INTERFACE:
!

   subroutine ResetHead_(BFile)
      implicit none
      
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile), intent(inout) :: BFile

! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: ResetHead_()'

      BFile%head%ittl  = ''
      BFile%head%jttl  = ''
      BFile%head%sdain = ''
      BFile%head%dtin  = ''
      BFile%head%trunc = ''
      BFile%head%nexp  = -1
      BFile%head%mMax  = -1
      BFile%head%mnwv2 = -1
      BFile%head%imax  = -1
      BFile%head%jmax  = -1
      BFile%head%kmax  = -1
      BFile%head%ihr   = -1
      BFile%head%idy   = -1
      BFile%head%imo   = -1
      BFile%head%iyr   = -1
      BFile%head%fhr   = -1
      BFile%head%fdy   = -1
      BFile%head%fmo   = -1
      BFile%head%fyr   = -1

      if(allocated(BFile%head%delsig))&
                deallocate(BFile%head%delsig)

      if(allocated(BFile%head%SigInt))&
                deallocate(BFile%head%SigInt)

      if(allocated(BFile%head%SigMid))&
                deallocate(BFile%head%SigMid)

      if(allocated(BFile%head%rlon))&
                deallocate(BFile%head%rlon)

      if(allocated(BFile%head%clon))&
                deallocate(BFile%head%clon)

      if(allocated(BFile%head%slon))&
                deallocate(BFile%head%slon)

      if(allocated(BFile%head%rlat))&
                deallocate(BFile%head%rlat)

      if(allocated(BFile%head%clat))&
                deallocate(BFile%head%clat)

      if(allocated(BFile%head%slat))&
                deallocate(BFile%head%slat)

      return

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_GetOneDim - return information about one dimension of BAM file.
!
!
! 
! !DESCRIPTION: Rotina que retorma informacão sobre um das dimensões do arquivo
!               do modelo BAM. Podem ser retornadas informacões sobre:
!               
!               1. IMax : Número de pontos na direcão I (longitude)
!               2. JMax : Número de pontos na direcão J (latitude)
!               3. KMax : Número de pontos na direcão K (níveis verticais)
!               4. Mend : comprimento de onda (spectral)
!
! !INTERFACE:
!

   function BAM_GetOneDim(BFile, DName) result(dim)
      
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(in   ) :: BFile

      !BAM dimension name
      character(len=*),  intent(in   ) :: DName
      !
      ! Can be:
      !   1. imax - points in i direction (longitude)
      !   2. jmax - points in j direction (latitude)
      !   3. kmax - points in k direction (levels)
      !   4. mend - wave number (spectral)
      !
!
! !OUTPUT PARAMETERS:
!
      integer,           intent(  out) :: dim
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!

      character(len=100), parameter :: myname_=':: BAM_GetOneDim( ... )'

      character(len=4) :: DimName

      DimName = Trim(Adjustl(lcase(DName)))

      select case (DimName)
         case ('imax')
            dim = BFile%head%IMax
         case ('jmax')
            dim = BFile%head%JMax
         case ('kmax')
            dim = BFile%head%KMax
         case ('mend')
            dim = BFile%head%mMax - 1
         case default
            write(*,'(4A)')trim(myname_),': wrong dimension <',trim(DimName),'>'
            write(*,'( A)')'try: imax, jmax, kmax, mend'
            dim = -1
      end select

   end function
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_GetTimeInfo - routine to return some information about the time
!                              of the BAM file 
!
! 
! !DESCRIPTION: Esta rotina retorna informacões sobre a data dos arquivos do
!               modelo BAM. Podem ser retornadas as seguintes informacões:
!               
!               1. ihr: Hora da condicão inicial utilizada para a simulacão
!               2. iyr: Ano da condicão inicial utilizada para a simulacão
!               3. idy: dia da condicão inicial utilizada para a simulacão
!               4. imo: mês da condicão inicial utilizada para a simulacão
!               5. fhr: hora da previsão da simulacão
!               6. fyr: ano da previsão da simulacão
!               7. fdy: dia da previsão da simulacão
!               8. fmo: mês da previsão da simulacão
!
! !INTERFACE:
!

   function BAM_GetTimeInfo(BFile, DName) result(dt)
      
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(in   ) :: BFile

      ! BAM time request
      character(len=*),  intent(in   ) :: DName
      !
      ! Can be:
      !   1. ihr: request hour of initial condition
      !   2. iyr: request year of initial condition
      !   3. idy: request day of initial condition
      !   4. imo: request month of initial condition
      !   5. fhr: request hour of forecast
      !   6. fyr: request year of forecast
      !   7. fdy: request day of forecast
      !   8. fmo: request month of forecast
!
! !OUTPUT PARAMETERS:
!
      ! time of simulation
      integer,           intent(  out) :: dt
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: BAM_GetTimeInfo( ... )'

      character(len=4) :: DimName

      DimName = Trim(Adjustl(lcase(DName)))

      select case (DimName)
         case ('iyr')
            dt = BFile%head%iyr
         case ('imo')
            dt = BFile%head%imo
         case ('idy')
            dt = BFile%head%idy
         case ('ihr')
            dt = BFile%head%ihr
         case ('fyr')
            dt = BFile%head%fyr
         case ('fmo')
            dt = BFile%head%fmo
         case ('fdy')
            dt = BFile%head%fdy
         case ('fhr')
            dt = BFile%head%fhr

         case default
            write(*,'(4A)')trim(myname_),': wrong dimension <',trim(DimName),'>'
            write(*,'( A)')'try:'
            write(*,'( A)')' * ihr, idy, imo, iyr: Initial Time'
            write(*,'( A)')' * fhr, fdy, fmo, fyr: Forecast Time'
            write(*,'( A)')''
            dt = -1
      end select

   end function
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_GetDims - routine to return informations about all BAM file
!                          dimensions. 
!
! 
! !DESCRIPTION: Esta rotina retorna informacões sobre todas as dimensões do
!               modelo BAM. São retornadas as seguintes informacões:
!
!               1. IMax : Número de pontos na direcão I (longitude)
!               2. JMax : Número de pontos na direcão J (latitude)
!               3. KMax : Número de pontos na direcão K (níveis verticais)
!               4. Mend : comprimento de onda (spectral)

!
! !INTERFACE:
!

   subroutine BAM_GetDims(BFile, Imax, Jmax, Kmax, Mend, istat)

      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(in   ) :: BFile

      !   1. imax - points in i direction (longitude)
      integer,           intent(  out) :: IMax

      !   2. jmax - points in j direction (latitude)
      integer,           intent(  out) :: JMax

      !   3. kmax - points in k direction (levels)
      integer,           intent(  out) :: KMax

      !   4. mend - wave number (spectral)
      integer,           intent(  out) :: Mend
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!

      character(len=100), parameter :: myname_=':: BAM_GetDims( ... )'
      
      IMax  = BFile%head%IMax
      JMax  = BFile%head%JMax
      KMax  = BFile%head%KMax
      Mend  = BFile%head%mMax - 1

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IFUNCTION: BAM_GetNLevels - return how many vertical levels has one
!                             give variable
!
! 
! !DESCRIPTION: Esta funcão retorna o número de níveis verticais que uma dada
!               variável possui.
!
!
!
! !INTERFACE:
!

   function BAM_GetNlevels(BFile,VName,istat) result(nlevs)

      implicit none

!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(in   ) :: BFile

      ! Name of a BAM variable
      character(len=*),  intent(in   ) :: VName
      
!
! !OUTPUT PARAMETERS:
!
      integer, optional, intent(  out) :: istat
!
! !RETURN VALUE:
!
      integer                          :: NLevs
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: BAM_GetNLevels( ... )'
     

      type(BAM_fld), pointer :: fld
      integer                :: f
      character(len=strlen)  :: InqName
      character(len=strlen)  :: FLDName

      if(present(istat)) istat = 0


      InqName = trim(adjustl(lcase(VName)))

      NLevs = -1

      fld => BFile%root
      do f=1,BFile%fcount

         FLDName = trim(adjustl(lcase(fld%name)))

         if(trim(InqName) .eq. trim(FLDName))then
            NLevs = fld%nlevs
            if(present(istat)) istat = 0
            return
         endif

         fld => fld%next
      enddo

      if(NLevs .eq. -1 )then
         write(*,'(4A)')trim(myname_),': variable not found ! <',trim(InqName),trim(FLDName)
         if(present(istat)) istat = -1
      endif

      return

   end function
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_GetWCoord - routine to return informations world coordinates
!                            of BAM model file
!
! 
! !DESCRIPTION: Esta rotina retorna um vetor contendo o valor de uma determinada
!               informacão geográfica do modelo BAM. Podem ser retornadas as 
!               seguintes informacões:
!
!              1. rlon : longitude real
!              2. slon : seno da longitude real
!              3. clon : cosseno da longitude real
!              4. rlat : latitude real
!              5. slat : seno da latitude real
!              6. clat : cosseno da latitude real
!
! !INTERFACE:
!

   subroutine  BAM_GetWCoord(BFile, what, coord, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(in   ) :: BFile

      ! Name of inquired Word Coordinate
      character(len=*),  intent(in   ) :: what
      ! 
      ! Can be:
      !        1. rlon : real longitude
      !        2. slon : sine of real longitude
      !        3. clon : cosine of real longitude
      !        4. rlat : real latitude
      !        5. slat : sine of real latitude
      !        6. clat : cosine of real latitude
      !
!
! !OUTPUT PARAMETERS:
!
      real(r4),          intent(inout) :: coord(:)
      integer, optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!

      character(len=100), parameter :: myname_=':: BAM_GetWCoord( ... )'

      integer :: lenIn
      integer :: lenOu

      select case (trim(what))
         case('rlon') ! real longitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%head%IMax
            if (lenIn.ne.lenOu) then
               write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:'
               write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu
               return
            endif

            coord = BFile%head%rlon

         case('slon') ! sine of longitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%head%IMax
            if (lenIn.ne.lenOu) then
               write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:'
               write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu
               return
            endif

            coord = BFile%head%slon

         case('clon') !cosine of longitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%head%IMax
            if (lenIn.ne.lenOu) then
               write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:'
               write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu
               return
            endif

            coord = BFile%head%clon

         case('rlat') ! real latitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%head%JMax
            if (lenIn.ne.lenOu) then
               write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:'
               write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu
               return
            endif

            coord = BFile%head%rlat

         case('slat') ! sine of latitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%head%JMax
            if (lenIn.ne.lenOu) then
               write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:'
               write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu
               return
            endif

            coord = BFile%head%slat

         case('clat') ! cosine of latitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%head%JMax
            if (lenIn.ne.lenOu) then
               write (stdout,'(2(1x,A))')trim(myname_),':ERROR, wrong size of coordinate array:'
               write (stdout,'(I4,1x,A,1x,I4)')lenIn,' .ne. ',lenOu
               return
            endif

            coord = BFile%head%clat

         case default
            write(stdout,'2(1x,A)')trim(myname_),': ERROR'
            write(stdout,'2(1x,A)')'Wrong coordinate inquired :',trim(what)
            write(stdout,'2(1x,A)')'validy coordinates:'
            write(stdout,'2(1x,A)')' '
            write(stdout,'2(1x,A)')'rlon : real longitude'
            write(stdout,'2(1x,A)')'clon : cosine of real longitude'
            write(stdout,'2(1x,A)')'slon : sine of real longitude'
            write(stdout,'2(1x,A)')' '
            write(stdout,'2(1x,A)')'rlat : real latitude'
            write(stdout,'2(1x,A)')'clat : cosine of real latitude'
            write(stdout,'2(1x,A)')'slat : sine of real latitude'

            if(present(istat))istat = -1
            return 

      end select

   endsubroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_GetVerticalCoord - return informations vertical coordinates
!                            of BAM model.
!
! 
! !DESCRIPTION: Esta rotina retorna um vetor contendo informacões sobre a
!               coordenada vertical do modelo BAM.
!               Podem ser retornadas as seguintes informacões:
!              1. Ak :
!              2. Bk :
!              3. Ck :
!              4. SI :
!              5. SL :
!              6. DL :
!
!
! !INTERFACE:
!

   subroutine BAM_GetVerticalCoord(BFile, what, vcoord, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),     intent(in   ) :: BFile

      ! Name of inquired Vertical Coordinate parameter
      character(len=*),  intent(in   ) :: what
!
! !OUTPUT PARAMETERS:
!   
      real(r8),          intent(inout) :: vcoord(:)
      integer, optional, intent(  out) :: istat

! !REMARKS:
!
!  Pressure is defined as:
!       \begin{equation}
!          p_{(i,j,k)} = A_{k}P_{0}+B_{k}P_{s}(i,j)
!       \end{equation}
!
!  where $p$ is the pressure at a given level and latitude, longitude grid point. 
!  The coefficients $A$, $B$ and $P_{0}$ are constants. $P_{s}$ is the model's current 
!  surface pressure. $P_{0}$ is set in the model code. The input model initial 
!  conditions dataset sets $A$ and $B$ through the variables hyam, hyai, hybm, and hybi. 
!  The subscript "i" refers to interface levels, and "m" refers to the mid-point levels. 
!  "hyam" then refers to Hybrid level "A" coefficient on the interfaces. 
!
!  More details on the theoretical nature of the vertical coordinate system can 
!  be found in Collins et al. [2004]. 
!
!  Collins, W. D., P. J. Rasch, and Others, Description of the NCAR Community 
!  Atmosphere Model (CAM 3.0), Technical Report NCAR/TN-464+STR, National Center 
!  for Atmospheric Research, Boulder, Colorado, 210 pp., 2004. 
!
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!

      character(len=100), parameter :: myname_=':: BAM_GetWCoord( ... )'

      character(len=2) :: vcn
      integer          :: i
   
      if(present(istat)) istat = 0

      vcn = ucase(trim(what))

      select case (trim(vcn))
         case ( 'AK' )
            vcoord = -9.99
         case ( 'BK' )
            vcoord = BFile%head%SigInt
         case ( 'CK' )
            vcoord = -9.99
         case ( 'SI' )
            vcoord = BFile%head%SigInt
         case ( 'SL' )
            vcoord = BFile%head%SigMid
         case ( 'DL' )
            vcoord = BFile%head%DelSig
         case default
            write (stdout,'(3(1x,A))')trim(myname_),': unknown requested parameter,:',trim(vcn)
            if(present(istat))istat = -1
      end select

      return
   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_GetSigValues - return vertical sigma parameters
!
! 
! !DESCRIPTION: Esta rotina retorna os valores dos seguintes parametros da
!               coordenada vertical sigma:
!
!              1. DelSig : diferenca entre os niveis sigma
!              2. SigInt : interface entre os niveis sigma
!              3. SigMid : ponto médio entre os níveis sigma
!
! !INTERFACE:
!

   subroutine BAM_GetSigValues(BFile, DelSig, SigInt, SigMid, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      type(BAMFile),  intent(in   ) :: BFile
!
! !OUTPUT PARAMETERS:
!
      real(r8),          intent(inout) :: DelSig(:)
      real(r8),          intent(inout) :: SigInt(:)
      real(r8),          intent(inout) :: SigMid(:)
      integer, optional, intent(  out) :: istat
      
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: BAM_GetSigmaValues( ... )'

      if(present(istat)) istat = 0
      
      DelSig = BFile%head%DelSig
      SigInt = BFile%head%SigInt
      SigMid = BFile%head%SigMid


   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: ReadFLDS_ - populate BAMFile structure < BFile%flds >
!
! 
! !DESCRIPTION: Esta rotina não retorna nenhuma informacão, ao invés disto ela
!               é utilizada para ler todos os campos previstos presentes em um 
!               arquivo de previsão do modelo BAM. Todos os campos são lidos e
!               guardados na variável flds da estrutura de dados BAMFile, para
!               depois ser acessada.
!
!
! !INTERFACE:
!

   subroutine ReadFLDS_(BFile, istat)

      implicit none
!
! !INPUT PARAMETERS:
!     

      ! BAM file structure
      type(BAMFile),     intent(inout) :: BFile

!
! !OUTPUT PARAMETERS:
!  

      integer, optional, intent(  out) :: istat

! !TO DO:
! 
!   criar métodos para acessar os campos armazenados na estrutura BAMFile que
!   sejam transparentes ao usuário, porém não podem estar em conflito com os já
!   criados para a leitura sequencial e individual de cada campo, como as
!   rotinas: SGetFLD_1D, SGetFLD_2D, DGetFLD_1D, DGetFLD_2D.
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: ReadFLDS_( ... )'

      real (R8), dimension (:),   allocatable :: bufx
      real (R4), dimension (:),   allocatable :: bufs
      real (R8), dimension (:,:), allocatable :: bufw
      real (R4), dimension (:,:), allocatable :: bufr

      integer (I4) :: ifday
      real    (R4) :: tod
      integer (I4) :: idate(4)
      integer (I4) :: idatec(4)


      integer :: fld
      integer :: lev
      integer :: iret

      integer :: IMax
      integer :: JMax
      integer :: KMax
      integer :: Mend
      integer :: mnwv2

      !
      ! geting some paramters
      !

      call BAM_GetDims(BFile, IMax, JMax, KMax, Mend)
      MnWv2 = (Mend+1)*(Mend+2)

      !
      ! Init Spectral parameters
      !

      call InitRecomposition(Mend, IMax, JMax)
 
      !
      ! back to begin of file
      !

      rewind(BFile%ufct) 

      !
      ! read data information
      !
      
      read (BFile%ufct) ifday,tod,idate,idatec


      !
      ! Get root file information
      !

      BFile%flds => BFile%root

      !
      ! BAM fct files contain spectral an grid point data.
      ! This data are stored in a sequential unformatted 
      ! format, so we need to access (through) the whole file!
      !

      do fld=1,BFile%fcount

         allocate(BFile%flds%grid(imax,jmax,BFile%flds%nlevs))

         if (BFile%flds%nharm .EQ. mnwv2) then

            Allocate (bufx (mnwv2))
            Allocate (bufs (mnwv2))
            Allocate (bufw (imax,jmax))

            DO lev=1,BFile%flds%nlevs

               read (BFile%ufct,IOSTAT=iret) bufs

               bufx(1:mnwv2) = real(bufs(1:mnwv2),R8)

               call RecompositionScalar(1, bufx, bufw)

               BFile%flds%grid(:,:,lev) = real(bufw,R4)

            ENDDO

            DeAllocate (bufx)
            DeAllocate (bufs)
            DeAllocate (bufw)

         else
         
            DO lev=1,BFile%flds%nlevs

               read (Bfile%ufct,IOSTAT=iret) BFile%flds%grid(:,:,lev)

            ENDDO

         endif

         BFile%flds => BFile%flds%next
      enddo

      !
      ! reset spectral/grid parameters
      !
      
      call ClsMemRecomposition ( )

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IFUNCTION: FindFLD_ - find position of a forecasted field in the BAM file
!
! 
! !DESCRIPTION: Esta funcão retorna a posicão de um determinado campo previsto
!               pelo modelo BAM indicado pelo arquivo DIR e assim poder acessa-lo
!               no arquivo FCT.
!
!
! !INTERFACE:
!

   function FindFLD_(BFile, wfld, wlev) result(idx)
      implicit none
!
! !INPUT PARAMETERS:
!     

      type(BAMFile),     intent(in   ) :: BFile ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
!
! !RETURN VALUE:
!

      integer :: idx ! Field position
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_=':: FindFLD_( ... )'
      
      character(len=strlen)  :: InqName
      character(len=strlen)  :: FldName

      type(BAM_fld), pointer :: fld
      integer :: ilev
      integer :: ifld

      !
      ! Get root file information
      !

      fld => BFile%root

      !
      ! BAM fct files contain spectral an grid point data.
      ! This data are stored in a sequential unformatted 
      ! format, so we need to access (through) the whole file!
      !

      InqName = Trim(adjustl(lcase(wfld)))

      idx  = -1
      ilev = 0
      do ifld=1,BFile%fcount

         FldName = Trim(Adjustl(lcase(fld%name)))

         if ( trim(InqName) .eq. trim(FldName) )then

            if(wlev .gt. fld%nlevs)then
               write(stdout,*)trim(myname_),': error, wlev > nlevs :', wlev, fld%nlevs
               return
            endif

            idx = ifld

            return
         else
            ilev = ilev + fld%nlevs
         endif

         fld => fld%next
      enddo

   end function
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SGetFLD_1D - return a single precision 1D array with a requested
!                         forecast BAM field.
!
! 
! !DESCRIPTION: Esta rotina retorna um vetor 1D em precisão simples contendo o
!               campo previsto pelo modelo BAM que foi requisitado.
!
! !INTERFACE:
!

   subroutine SGetFLD_1D(BFile, wfld, wlev, grd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      type(BAMFile),     intent(in   ) :: BFile ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
!
! !OUTPUT PARAMETERS:
! 
      real(r4),          intent(inout) :: grd(:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!    DGetFLD_1D( ) - return a double precision 1D BAM Field
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: SGetFLD_1D( ... )'

      real(r8) :: TmpGrd(size(grd,1))
      integer  :: iret

      call DGetFLD_1D(BFile, wfld, wlev, TmpGrd, istat)
      if(present(istat))istat = iret

      grd = real(TmpGrd,r4)

      return

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SGetFLD_2D - return a single precision 2D array with a requested
!                         forecast BAM field.
!
! 
! !DESCRIPTION: Esta rotina retorna um vetor 2D em precisão simples contendo o
!               campo previsto pelo modelo BAM que foi requisitado.
!
! !INTERFACE:
!

   subroutine SGetFLD_2D(BFile, wfld, wlev, grd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      type(BAMFile),     intent(in   ) :: BFile ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
!
! !OUTPUT PARAMETERS:
! 
      real(r4),          intent(inout) :: grd(:,:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!    DGetFLD_2D( ) - return a double precision 2D BAM Field
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: SGetFLD_2D( ... )'

      
      real(r8) :: TmpGrd(size(grd,1),size(grd,2))
      integer  :: iret

      call DGetFLD_2D(BFile, wfld, wlev, TmpGrd, iret)
      if(present(istat))istat = iret

      grd = real(TmpGrd,r4)

      return

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: DGetFLD_2D - return a double precision 2D array with a requested
!                         forecast BAM field.
!
! 
! !DESCRIPTION: Esta rotina retorna um vetor 2D em precisão dupla contendo o
!               campo previsto pelo modelo BAM que foi requisitado.
!
! !INTERFACE:
!

   subroutine DGetFLD_2D(BFile, wfld, wlev, grd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      type(BAMFile),     intent(in   ) :: BFile ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
!
! !OUTPUT PARAMETERS:
! 
      real(r8),          intent(inout) :: grd(:,:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!    DGetFLD_1D( ) - return a double precision 1D BAM Field
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: DGetFLD_2D( ... )'

      real(r8), allocatable :: fld (:)
      integer :: i, j, k
      integer :: IMax, JMax
      integer :: npts
      integer :: iret

      npts = size(grd)

      allocate(fld(npts))

      call DGetFLD_1D(BFile, wfld, wlev, fld, iret)
      if(present(istat)) istat = iret

      IMax = size(grd,1)
      JMax = size(grd,2)

      k = 1
      do j = 1,JMax
         do i = 1, IMax
            grd(i,j) = fld(k)
            k = k + 1
         enddo
      enddo
      
   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SGetFLD_1D - return a double precision 1D array with a requested
!                         forecast BAM field.
!
! 
! !DESCRIPTION: Esta rotina retorna um vetor 1D em precisão dupla contendo o
!               campo previsto pelo modelo BAM que foi requisitado.
!
! !INTERFACE:
!     
   subroutine DGetFLD_1D(BFile, wfld, wlev, grd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      type(BAMFile),     intent(in   ) :: BFile ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
!
! !OUTPUT PARAMETERS:
! 
      real(r8),          intent(inout) :: grd(:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!    BAM_GetDims( ) - return BAM field dimensions
!    FindFLD_( ) - return BAM field position
!    ReadField( ) - read a BAM field in double or sigle precision
!    InitRecomposition( ) - initialize spectral2grid routines
!    RecompositionScalar( ) - convert spectral2grid fields
!    ClsMemRecomposition( ) - finalize spectral2grid routines
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: DGetFLD_1D( ... )'

      integer :: ifld
      integer :: ilev
      integer :: iret

      type(BAM_fld), pointer :: fld

      real (R8), dimension (:),   allocatable :: bufx
      real (R4), dimension (:),   allocatable :: bufs
      real (R8), dimension (:,:), allocatable :: bufw
      real (R4), dimension (:,:), allocatable :: bufr
      
      integer (I4) :: ifday
      real    (R4) :: tod
      integer (I4) :: idate(4)
      integer (I4) :: idatec(4)

      integer :: IMax
      integer :: JMax
      integer :: KMax
      integer :: Mend
      integer :: Mnwv2

      integer :: i, j, k
      integer :: idx
      integer :: npts

      character(len=strlen)  :: InqName
      character(len=strlen)  :: FldName

      if(present(istat)) istat = 0

      !
      ! get BAM file dimensions
      !

      call BAM_GetDims(BFile, imax, jmax, kmax, Mend)
      Mnwv2 = (Mend+1)*(Mend+2)

      !
      ! Init Spectral parameters
      !

      call InitRecomposition(Mend, IMax, JMax)

      !
      ! Find field inside BAM file
      !

      idx = FindFLD_(BFile, wfld, wlev)
      if (idx .lt. 0)then
!         write(*,*)trim(myname_),' :: Field Not found ...'
         call perr(trim(myname_),'Field Not Found ...['//trim(BFile%ffct)//' ]')
         if(present(istat))istat = idx
         return
      endif

      !
      ! back to begin of file
      !

      rewind(BFile%ufct) 

      !
      ! read header time information
      !
      
      read (BFile%ufct) ifday,tod,idate,idatec

      !
      ! Get root file information
      !

      fld => BFile%root

      !
      ! BAM fct files contain spectral an grid point data.
      ! This data are stored in a sequential unformatted 
      ! format, so we need to access (through) the whole file!
      !

      !
      ! skipping undesired fields
      !
      if (idx .gt. 1)then
         do ifld=1,idx-1
            do ilev=1,fld%nlevs
               call ReadField (BFile%ufct, iret)
               if (iret.ne.0)then
                  if(present(istat)) istat = iret
                  write(stdout,*)trim(myname_),': error to read file <jump 1> ::','['//trim(BFile%ffct)//' ], ',iret
               endif
            enddo
            fld => fld%next
         enddo

         do ilev=1,wlev-1
             call ReadField (BFile%ufct, iret)
             if (iret.ne.0)then
                if(present(istat)) istat = iret
                write(stdout,*)trim(myname_),': error to read file <jump 2> ::','['//trim(BFile%ffct)//' ], ',iret
             endif
         enddo
      endif

      !
      ! Get Field
      !
      allocate(bufs(fld%nharm))
      
      call ReadField (BFile%ufct, bufs, iret)

      if (iret.ne.0)then
         if(present(istat)) istat = iret
         write(stdout,*)trim(myname_),': error to read file ::','['//trim(BFile%ffct)//' ], ',iret
      endif

      npts = size(grd)

      if ( ( npts .eq. (IMax*JMax) ) .and. (fld%nharm .eq. mnwv2 )) then
         !
         ! field is spectral but need return grid point
         !

         allocate (bufx (mnwv2))

         bufx(1:mnwv2) = real(bufs(1:mnwv2),R8)

         deallocate(bufs)

         allocate (bufw (imax,jmax))

         call RecompositionScalar(1, bufx, bufw)

         k = 1
         do j = 1, JMax
            do i = 1, IMax
               grd(k) = bufw(i,j)
               k = k + 1
            enddo
         enddo


         deallocate(bufw)

      else

         grd = real(bufs,r8)

      endif

      !
      ! reset spectral/grid parameters
      !
      
      call ClsMemRecomposition ( )

      return

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SRead1D_ - read and return a 1D sigle precision BAM field.
!
! 
! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um vetor 1D em
!               precisão simples
!
! !INTERFACE:
!   
   subroutine SRead1D_(funit, fld, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      real(r4),              intent(  out) :: fld(:)
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter          :: myname_ = ':: SRead1D_( ... )'

      integer :: iret

      if(present(istat)) istat = 0

      read(unit = funit, iostat = iret) fld
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read field, ',iret
         if(present(istat)) istat = iret
      endif

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SRead2D_ - read and return a 2D sigle precision BAM field.
!
! 
! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um matriz 2D em
!               precisão simples
!
! !INTERFACE:
!   

   subroutine SRead2D_(funit, fld, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      real(r4),              intent(  out) :: fld(:,:)
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: SRead2D_( ... )'

      integer :: iret

      if(present(istat))istat=0

      read(unit = funit, iostat = iret) fld
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read field, ',iret
         if(present(istat)) istat = iret
      endif
      
   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SRead3D_ - read and return a 3D sigle precision BAM field.
!
! 
! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um vetor 3D em
!               precisão simples
!
! !INTERFACE:
!   
   subroutine SRead3D_(funit, fld,istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      real(r4),              intent(  out) :: fld(:,:,:)
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: SRead3D_( ... )'

      integer :: iret

      if(present(istat))istat=0

      read(unit = funit, iostat = iret) fld
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read file, ',iret
         if(present(istat)) istat = iret
      endif

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: DRead1D_ - read and return a 1D double precision BAM field.
!
! 
! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um vetor 1D em
!               precisão dupla.
!
! !INTERFACE:
!   
   subroutine DRead1D_(funit, fld, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      real(r8),              intent(  out) :: fld(:)
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter          :: myname_ = ':: SRead1D_( ... )'

      integer :: iret

      if(present(istat)) istat = 0

      read(unit = funit, iostat = iret) fld
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read file, ',iret
         if(present(istat)) istat = iret
      endif

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: DRead2D_ - read and return a 2D double precision BAM field.
!
! 
! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um matriz 2D em
!               precisão dupla.
!
! !INTERFACE:
!   

   subroutine DRead2D_(funit, fld, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      real(r8),              intent(  out) :: fld(:,:)
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: DRead2D_( ... )'

      integer :: iret

      if(present(istat))istat=0

      read(unit = funit, iostat = iret) fld
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read file, ',iret
         if(present(istat)) istat = iret
      endif
      
   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: DRead3D_ - read and return a 3D double precision BAM field.
!
! 
! !DESCRIPTION: Esta rotina lê e retorna um campo modelo BAM em um matriz 3D em
!               precisão dupla.
!
! !INTERFACE:
!   
   subroutine DRead3D_(funit, fld,istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      real(r8),              intent(  out) :: fld(:,:,:)
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = ':: DRead3D_( ... )'

      integer :: iret

      if(present(istat))istat=0

      read(unit = funit, iostat = iret) fld
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read file, ',iret
         if(present(istat)) istat = iret
      endif

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: SkipRead_ - skip a sequential read in a BAM field.
!
! 
! !DESCRIPTION: Esta rotina pula a leitura sequencial de um campo modelo BAM.
!
!
! !INTERFACE:
!   

   subroutine SkipRead_(funit, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
!
! !OUTPUT PARAMETERS:
! 
      integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter      :: myname_ = 'SkipRead_( ... )'

      integer :: iret

      if(present(istat))istat=0

      read(unit = funit, iostat = iret)
      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to skip read file, ',iret
         if(present(istat)) istat = iret
      endif

   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: BAM_WriteAnlHeader - write a Header information in a Initial
!                                 condition BAM file
!
!
! !DESCRIPTION: Esta rotina escreve o cabecalho do arquivo de condicão inicial
!               do modelo BAM.
!
! !INTERFACE:

  subroutine BAM_WriteAnlHeader(BAM, mydate, istat)

     implicit none
!
! !INPUT PARAMETERS:
!
     type(BAMFile),     intent(in   ) :: BAM       ! BAM files data type
     integer,           intent(in   ) :: mydate(:) ! Anl date
     
!
! !OUTPUT PARAMETERS:
!
     integer, optional, intent(  out) :: istat ! code error status

! !REVISION HISTORY:
! 	03 Aug 2016 - J. G. de Mattos - Initial code
!
!EOP
!-----------------------------------------------------------------------
!BOC
     character(len=100), parameter :: myname_=':: BAM_WriteAnlHeader( ... )'

     integer :: iret

     integer (i4) :: idate (4)
     integer (i4) :: idatec(4)
     integer (i4) :: ifday
     real (r4)    :: tod

     integer (i4) :: KMax
     integer (i4) :: KMaxP

     real (r8), allocatable :: del(:)
     real (r8), allocatable :: si(:)
     real (r8), allocatable :: sl(:)

     integer :: k
     real :: sumdel

    ! Get forecast day, time of day, dates

    ifday = 0
    tod   = 0.0

    ! -------------------
    ! idate(1) - hour
    ! idate(2) - month
    ! idate(3) - day
    ! idate(4) - year

    idate(4) = mydate(1)
    idate(2) = mydate(2)
    idate(3) = mydate(3)
    idate(1) = mydate(4)
    idatec   = idate

    !
    ! Get sigma levels
    !
    KMax  = BAM_GetOneDim(BAM, 'KMax')
    KMaxP = KMax + 1

    allocate( del( KMax) )
    allocate( si (KMaxP) )
    allocate( sl ( KMax) )

    call BAM_GetSigValues (BAM, del, si, sl, iret)

!    do k=1,kmaxp
!       write (6,'(a,i2,1(a,f10.6))') &
!            ' level = ', k, ' si  = ', real(si(k),r4)
!    enddo
!    write (6,'(a)')' '
!    sumdel = 0.0
!    do k=1,kmax
!       sumdel = sumdel + del(k)
!       write (6,'(a,i2,2(a,f10.6))') &
!            ' layer = ', k, ' sl = ', real(sl(k),r4), ' del = ', del(k)
!    enddo
!    write (6,'(/,a,i3,a,f12.8,/)') ' kmax = ', kmax, ' sum del = ', sumdel

!    sl    = sl(kmax:1:-1)
!    si    = si(kmaxp:1:-1)
!    si(1) = 0.000001_r8 ! to avoid floating point exceptions

    
    Write (BAM%uanl, iostat = iret) ifday, tod, idate, idatec, real(si,r4), real(sl,r4)
    if(present(istat)) istat = iret

    deallocate(del)
    deallocate(si)
    deallocate(sl)

  end subroutine
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: WriteField_MPI - write fields of BAM files from a MPI Pe.
!
! 
! !DESCRIPTION: Esta rotina escreve um campo do modelo BAM 
!               
!
! !INTERFACE:
!   

  subroutine WriteField_MPI(OutUnit, field, OutPe, iCount, istat)

     implicit none
!
! !INPUT PARAMETERS:
! 
     ! Output logical unit
     integer(i4),           intent(in   ) :: OutUnit

     ! Field to be writed
     real(r8),              intent(in   ) :: field(:)

     ! How many Pe's are working
     integer(i4),           intent(in   ) :: iCount

     ! What Pe will write
     integer(i4),           intent(in   ) :: OutPe
!
! !OUTPUT PARAMETERS:
! 

     integer(i4), optional, intent(  out) :: istat

!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
     character(len=100), parameter :: myname_=':: WriteFields_MPI( ... )'

     real(r8), allocatable :: buff(:)
     integer :: sizebuff
     integer :: Pe
     integer :: iret
   
     if(present(istat)) istat = 0

     sizebuff = size(field)

     allocate(buff(sizebuff))
      
     do Pe = 0, iCount-1

        if(Pe .eq. OutPe)then
        
           call WriteField_Serial(OutUnit, field, iret)

           if(iret .ne. 0)then
              write(stdout,*)trim(myname_),': error to write field, ',iret
              if(present(istat)) istat = iret
              return
           endif

        else

           call mpi_recv(buff, sizebuff, MPI_DOUBLE, Pe, MPITag, MPI_COMM_WORLD, status, iret)

           call WriteField_Serial(OutUnit, buff, iret)
           if(iret .ne. 0)then
              if(present(istat)) istat = iret
              return
           endif
        endif

     end do
      
     deallocate(buff)

  end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: WriteField_Serial_ - 
!
! 
! !DESCRIPTION: 
!              
!
! !INTERFACE:
!   

  subroutine WriteField_Serial(OutUnit, Field, istat)

     implicit none
!
! !INPUT PARAMETERS:
!
     ! Output logical unit
     integer(i4),           intent(in   ) :: OutUnit

     ! Field to be writed
     real(r8),              intent(in   ) :: Field(:)
!
! !OUTPUT PARAMETERS:
! 

     integer(i4), optional, intent(  out) :: istat

!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
     character(len=100), parameter :: myname_=':: WriteFields_Serial( ... )'

     real(r4), allocatable :: tmp(:)
     integer :: iret
     integer :: siz

     siz=size(Field)
     allocate(tmp(siz))
     tmp = real(Field,r8)

     if(present(istat)) istat = 0

!     write( OutUnit, iostat = iret ) Field
     write( OutUnit, iostat = iret ) tmp

     if(iret .ne. 0)then
        write(*,'(1A)')trim(myname_),': ERROR to write BAM file'
        if(present(istat)) istat = iret
        return
     endif

     return

  end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_SendField_ -
!
! 
! !DESCRIPTION:
!
!
! !INTERFACE:
!   

  subroutine BAM_SendField(MyPe, toPe, Field, istat)

     implicit none
!
! !INPUT PARAMETERS:
!
     ! Source Pe
     integer(i4),           intent(in   ) :: MyPe

     ! Target Pe
     integer(i4),           intent(in   ) :: toPe

     ! Field to be send
     real(r8),              intent(in   ) :: field(:)
!
! !OUTPUT PARAMETERS:
! 
     integer(i4), optional, intent(  out) :: istat
!
! !REVISION HISTORY: 
!
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
     character(len=100), parameter :: myname_=':: BAM_SendField( ... )'

     integer :: iret
     integer :: sizefield

     if(present(istat)) istat = 0

     sizefield = size(field)
      
     call mpi_send(field, sizefield, MPI_DOUBLE, toPe, MPITag, MPI_COMM_WORLD, iret)

     if(iret .ne. 0)then
        write(*,'(2A,I5,1x,A,1x,I5)')trim(myname_),': ERROR to send field from',MyPe,'to',toPe
        if(present(istat)) istat = iret
        return
     endif

  end subroutine

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: upper_case - convert lowercase letters to uppercase.
!
! !DESCRIPTION:
!
! !INTERFACE:

  function ucase(str) result(ustr)
    implicit none
  character(len=*), intent(in) :: str
  character(len=len(str))      :: ustr

! !REVISION HISTORY:
! 	13Aug96 - J. Guo	- (to do)
!EOP
!-----------------------------------------------------------------------
    integer i
    integer,parameter :: il2u=ichar('A')-ichar('a')

    ustr=str
    do i=1,len_trim(str)
      if(str(i:i).ge.'a'.and.str(i:i).le.'z')	&
      	ustr(i:i)=char(ichar(str(i:i))+il2u)
    end do
  end function ucase

!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: lower_case - convert uppercase letters to lowercase.
!
! !DESCRIPTION:
!
! !INTERFACE:

  function lcase(str) result(lstr)
    implicit none
    character(len=*), intent(in) :: str
    character(len=len(str))      :: lstr

! !REVISION HISTORY:
! 	13Aug96 - J. Guo	- (to do)
!EOP
!-----------------------------------------------------------------------
    integer i
    integer,parameter :: iu2l=ichar('a')-ichar('A')

    lstr=str
    do i=1,len_trim(str)
      if(str(i:i).ge.'A'.and.str(i:i).le.'Z')	&
      	lstr(i:i)=char(ichar(str(i:i))+iu2l)
    end do
  end function lcase

  subroutine perr1_(where, message)
     implicit none
     character(len=*), intent(in) :: where
     character(len=*), intent(in) :: message

     write(stderr,'(4A)')'Error at ',trim(where),' : ', trim(message)

  end subroutine

!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!BOP
!
! !FUNCTION: GetAvailUnit
!
! !DESCRIPTON: function to return next available logical unit
!
!
!             
!                 
! !INTERFACE:
!
   function GetAvailUnit( exclude ) result( lu )

      implicit none
!
! !INPUT PARAMETERS:
!
      ! Skip this logical unit      
      integer, optional :: exclude(:)
!
! !RETURN VALUE:
!
      integer :: lu
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=*), parameter :: myname_ = ':: GetAvailUnit( ... )'

      integer,          parameter :: MaxLogicalUnit = 254
      integer :: iunit
      integer :: ios
      logical :: isopen
      integer :: i

      

      ! start open loop for lun search
      find_unit:do iunit = 10, MaxLogicalUnit

         if (present(exclude))then
            do i=1,size(exclude)
               if (iunit.eq.exclude(i)) cycle find_unit
            enddo
         endif

         inquire (Unit = iunit, opened = isopen, iostat = ios )
         
         if (.not.isopen.and.ios.eq.0)then
            lu = iunit
            return
         endif

      end do find_unit

   end function GetAvailUnit


  subroutine setsig (si, sl, del)

    !     calculates the 
    !     sigma value at each interface and the 
    !     sigma value at midpoint of each layer given the
    !     sigma spacing for each layer.
    !
    !     argument(dimensions)          description
    !
    !     del(kmax)            input  : sigma spacing for each layer.
    !     si(kmaxp)            output : sigma value at each interface.
    !     sl(kmax)             output : sigma value at midpoint of
    !                                   each layer : (k=287/1005)
    !
    !                                                              1
    !                                   +-                      + ---
    !                                   |      k+1          k+1 |  k
    !                                   | si(l)    - si(l+1)    |
    !                           sl(l) = | --------------------- |
    !                                   | (k+1) (si(l)-si(l+1)) |
    !                                   +-                     -+
    !
    !     ci(kmaxp)            local  : ci(l)=1.0-si(l).

    implicit none

    real (kind=r8), intent (in   ) :: del(:)
    real (kind=r8), intent (inout) :: sl(:)
    real (kind=r8), intent (inout) :: si(:)

    integer (kind=i4) :: kmax
    integer (kind=i4) :: kmaxp
    integer (kind=i4) :: kmaxm, k
    real    (kind=r8) :: sumdel, rk, rk1, sirk, sirk1, dif

    real (kind=r8), allocatable  :: ci(:)

    kmax  = size(del)
    kmaxp = kmax + 1

    allocate(ci(kmaxp))

    ci(1)  = 0.0
    sumdel = 0.0

    do k = 1, kmax
       sumdel  = sumdel+del(k)
       ci(k+1) = ci(k)+del(k)
    enddo

    ci(kmaxp) = 1.0
    rk        = 287.05/1005.0
    rk1       = rk+1.0

    do k=1,kmaxp
       si( k ) = 1.0 - ci( k )
    enddo

    kmaxm = kmax-1
    do k=1,kmax
       !
       !     dif=si(k)**rk1-si(k+1)**rk1
       !
       sirk=exp(rk1*log(si(k)))
       if (k .le. kmaxm) then
          sirk1=exp(rk1*log(si(k+1)))
       else
          sirk1=0.0
       endif
       dif=sirk-sirk1
       dif=dif/(rk1*(si(k)-si(k+1)))
       !
       !     sl(k)=dif**(one/rk)
       !
       sl(k)=exp(log(dif)/rk)
    enddo


!    write (6,'(/,a,/)') ' from setsig: '
!    do k=1,kmaxp
!       write (6,'(a,i2,2(a,f10.6))') &
!            ' level = ', k, ' ci = ', ci(k), ' si  = ', si(k)
!    enddo
!    write (6,'(a)')' '
!    do k=1,kmax
!       write (6,'(a,i2,2(a,f10.6))') &
!            ' layer = ', k, ' sl = ', sl(k), ' del = ', del(k)
!    enddo
    write (6,'(/,a,i3,a,f12.8,/)') ' kmax = ', kmax, ' sum del = ', sumdel

    deallocate(ci)

  end subroutine setsig
  !EOC

end module sigio_bammod
