!-----------------------------------------------------------------------------!
!             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
!  ------------------------+-----------------------------------------
!                          |
!   Open                   | Open a BAM file
!   Close                  | Close a BAM file
!   GetField               | Return a BAM field from a file
!   GetUV                  ! Return fields of zonal and meridional wind 
!   GetOneDim              | Return just one of 4 BAM field dimensions
!   GetDims                | Return BAM field dimensions
!   GetOFS                 !
!   GetNlevels             | Return the number of leves of a field
!   GetVarNames            ! Return a table with all variables names (one by row)
!   GetVerticalCoord       | Return information about vertical coordinate
!   GetWCoord              | Return BAM world coordinates
!   GetTimeInfo            | Return time info
!   GetPhysics             | Return Physics Scheme
!   isHybrid               | Return .true. or .false. (.false. model use Sigma)
!   WriteAnlHeader         | Write the Anl file header
!   WriteField             | Write a BAM field (mpi or serial)
!                          |
!  ------------------------+-----------------------------------------
! \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, only: BAMFile
!    \end{verbatim}
!
!    \item Defina uma variável que conterá a estrutura de dados:
!
!    \begin{verbatim}
!       type(BAMFile) :: bam
!    \end{verbatim}
!
!    \item Defina algumas variáveis para auxiliar na leitura das informacões
!
!    \begin{verbatim}
!        character(len=256) :: FileFct
!        character(len=256) :: FileDir
!        integer            :: iMax
!        integer            :: jMax
!        integer            :: kMax
!        integer            :: Mend
!        integer            :: MnvWv2
!        integer            :: iret
!        real, allocatable  :: grid(:)
!    \end{verbatim}
!
!    \item Defina qual o arquivo deverá ser lido (fct/anl,dir). Os arquivos do bam são
!    compostos por um arquivo de cabecalho (dir) e um arquivo binario (fct/anl):
! 
!    \begin{verbatim}
!      FileDir = 'GFCTNMC20131231002013123106F.dir.TQ0062L028'
!      FileFct = 'GFCTNMC20131231002013123106F.fct.TQ0062L028'
!    \end{verbatim}
! 
!    \item Utilize a rotina específica para a abertura do arquivo:
! 
!    \begin{verbatim}
!  
!       call bam%Open(FileFct, FileDir, iret)
!   
!    \end{verbatim}
!
!    \item Obtenha as informacões da grade:
!
!    \begin{verbatim}
!
!    iMax=bam%GetOneDim('imax')
!    jMax=bam%GetOneDim('jmax')
!    kMax=bam%GetOneDim('kmax')
!    Mend=bam%GetOneDim('mend')
!
!    MnWv2 = (Mend+1)*(Mend+2)
!
!    \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(iMax*jMax))
!       
!       VName = 'VIRTUAL TEMPERATUE'
!       ilev  = 1
!       
!       call bam%GetField(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(iret)
!    \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

#ifdef useMPI
   use MPI
#endif
   use typeKinds, only: i4 => Long, &
                        i8 => LLong,  &
                        r4 => Single, &
                        r8 => Double
   use EndianUtility
   use ModConstants
   use TransformTools, only : specTrans
   implicit none
   Private

#ifdef useMPI
   ! MPI Parameters
   integer :: MPITag = 100
   integer :: status(MPI_Status_size)
#endif

   

   ! BAM header structure
   type, extends(specTrans):: BAM_head
!      private
      character (len = 21) :: ittl
      character (len = 40) :: specal
      character (len =150) :: jttl
      character (len =  4) :: sdain
      character (len =  4) :: dtin
      character (len =  5) :: trunc
      integer (I4)         :: nexp
      integer (I4)         :: mMax
      integer (I4)         :: iosize
      integer (I4)         :: kmax
      integer (I4)         :: lsm
      integer (I4)         :: pbl
      integer (I4)         :: ihr, idy, imo, iyr
      integer (I4)         :: fhr, fdy, fmo, fyr

      !  - ID of Vertical Coordinate
      !    = 1 Sigma (0 for old files)
      !    = 2 ec-Hybrid
      !    = 3 NCEP General Hybrid
      real (I4) :: idvc

      ! vertical coordinate info
      !  - ID of Sigma Structure (IDSL)
      !    = 1 Phillips
      !    = 2 Mean
      real (I4) :: idsl

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

      ! Hybrid-Sigma levels
      real (r8), dimension (:), pointer :: ak  => null()
      real (r8), dimension (:), pointer :: bk  => null()
      real (r8), dimension (:), pointer :: ck  => null()

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

   end type

   ! BAM fields structure
   type, public:: BAM_fld
      character (len = 40)   :: Name  ! Long field Name
      character (len =  4)   :: ProDia! Prognostig / Diagnostic 
      integer (I4)           :: nharm ! variable array size
      integer (I8)           :: pmark ! Initial Position Marker (bytes)
      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, extends(BAM_head), public :: BAMFile
!      private
      character(len=strlen)  :: fBin  ! Anl or Fct file name
      character(len=strlen)  :: fHead ! dir, dic or din file name (header informations)
      character(len=strlen)  :: ftype ! type of binary file (unf, icn, inz, or fct)
      character(len=strlen)  :: oMode ! Open mode (w: write, r: read)
      logical, public        :: isHybrid ! .true. or .false. (if .false. vertical coodinate is sigma)
      logical                :: isBigEndian ! Machine is Big Endian?
      integer (I4)           :: BHeadSize ! Size of binary head buffer (bytes)
      integer (I4), pointer  :: uBin => null()  ! Anl of Fct file opened unit
      integer (I4), pointer  :: uHead => null() ! dir, dic or din 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
      
      contains
         procedure, public :: open => bamOpen_
         procedure, public :: close => bamClose_
         procedure, public :: getOneDim => bamGetOneDim_
         procedure, public :: getTimeInfo => bamGetTimeInfo_
         procedure, public :: getDims => bamGetDims_
         procedure, public :: getOFS => bamGetOFS_
         procedure, public :: getNLevels => bamGetNLevels_
         procedure, public :: getWCoord => bamGetWCoord_
         procedure, public :: getVerticalCoord => bamGetVerticalCoord_
         procedure, public :: getPhysics => bamGetPhysics_
         procedure, public :: getSigValues => bamGetSigValues_
         procedure, public :: writeAnlHeader => bamWriteAnlHeader_
         procedure, public :: getVarNames => bamGetVarNames_
         procedure, public :: getNFields => bamGetnFields_

         procedure         :: SGetFLD_1d, SGetFLD_2d,&
                              DGetFLD_1d, DGetFLD_2d
         generic,   public :: getField => SGetFLD_1d, SGetFLD_2d,&
                                          DGetFLD_1d, DGetFLD_2d
         procedure, public :: getOField => getOrigField_1D
         procedure         :: getUV1D_, getUV2D_
         generic,   public :: getUV => getUV1D_, getUV2D_

   end type
!
! !PUBLIC MEMBER FUNCTIONS:
!

   public :: BAM_WriteField     ! Write a BAM field (mpi or serial)
#ifdef useMPI
   public :: BAM_SendField      ! if mpi code is used to send a field to write
#endif
   public :: BAM_GetAvailUnit


   interface BAM_GetHeadInfo
      module procedure ReadHead_
   end interface

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

#ifdef useMPI

   interface BAM_SendField
      module procedure   BAM_SendField_, BAM_SendFieldr4_
   end interface

   interface BAM_WriteField
      module procedure   WriteField_MPI_,   WriteField_Serial_, &
                       WriteField_MPIr4_, WriteField_Serialr4_
   end interface

#else

   interface BAM_WriteField
      module procedure   WriteField_Serial_, WriteField_Serialr4_
   end interface

#endif

   interface perr
      module procedure perr1_, perr2_
   end interface

   interface pwrn
      module procedure pwrn1_, pwrn2_
   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 bamOpen_(self, hFile, bFile, mode, ftype, initSpec, istat)

      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      class(BAMFile),             intent(inout) :: self

      ! BAM binary file (Analisys or Forecast)
      character(len=*),           intent(in   ) :: hFile

      ! BAM header file
      character(len=*), optional, intent(in   ) :: bFile

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

      ! File type: dir, fct, icn
      character(len=*), optional, intent(in   ) :: ftype
      ! Can be:
      !        1. unf: BAM initial condition file
      !        2. icn: BAM 0 hour forecast
      !        3. inz: BAM 0 hour forecast with normal mode initialization
      !        4. fct: BAM forecast 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
      !

      ! Flag to tell if initialize or not the spectral transform
      ! default is .TRUE.
      logical,          optional, intent(in   ) :: initSpec
      

!
! !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
!  29 sep 2020 - J. G. de Mattos - modify to class
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100), parameter :: myname_='bamOpen_( ... )'

      integer            :: iret
      integer            :: idx
      character(len=3)   :: hType, bType
      character(len=512) :: prefix 
      character(len=512) :: sulfix 
      logical            :: ok

      if(present(istat))istat = 0
      !---------------------------------------------------------------!
      ! get some information about BAM file
      ! header Type
      idx   = index(hFile,'.')
      hType = lcase(hFile(idx+1:idx+3))

      ! file prefix
      prefix = hFile(1:idx-1)

      ! file sulfix
      sulfix = hFile(idx+5:len_trim(hFile))

      !----------------------------------------------------------------!
      ! Some Sanity Check

      if(present(ftype))then
         self%ftype = lcase(ftype)
      else
         select case (hType)
            case('dic')
               self%ftype = 'icn'
            case('din')
               self%ftype = 'inz'
            case('dir')
               self%ftype = 'fct'
            case('dun')
               self%ftype = 'unf'
            case default
               write(stdout,*)trim(myname_),'Unknown file type:', trim(hFile)
               write(stdout,*)'Please use `ftype` to define explicity!'
               stop
         end select
      endif

      if (trim(self%ftype) .ne. 'unf' .and. &
          trim(self%ftype) .ne. 'icn' .and. &
          trim(self%ftype) .ne. 'fct' .and. &
          trim(self%ftype) .ne. 'dir')then
         write(stdout,*)trim(myname_),': ftype should be `unf`, `icn`, `fct` .or. `dir`'
         write(stdout,*) 'ftype was set to : ', trim(self%ftype)
         stop
      endif

      if (.not.present(bFile) .and. self%ftype .ne. 'dir')then
         self%fBin = trim(prefix)//'.'//trim(self%ftype)//'.'//trim(sulfix)
      else
         self%fBin = bFile
      endif

      if(present(mode))then
         self%oMode = trim(ucase(mode))
      else
         self%oMode = 'R'
      endif

      if (present(initSpec))then
         self%initSpec = initSpec
      else
         self%initSpec = .true.
      endif
      !----------------------------------------------------------------!

      self%fHead = trim(hFile)

      call openHeader_(self, iret)
      if (iret .ne. 0)then
         call perr(trim(myname_),'problem to OPEN header file '//trim(hFile), iret)
         if (present(istat))then
            istat = iret
            return
         endif
         stop
      endif

      call ReadHead_(self,iret)
      if (iret .ne. 0)then
         call perr(trim(myname_),'problem to READ header file '//trim(hFile), iret)
         if (present(istat))then
            istat = iret
            return
         endif
         stop
      endif

      ! if ftype is equal a dir, dont open binary file
      if (trim(self%ftype) .eq. 'dir') return


      call openBin_(self, iret)
      if (iret .ne. 0)then
         call perr(trim(myname_),'problem to OPEN binary file '//trim(self%fBin), iret)
         if (present(istat))then
            istat = iret
            return
         endif
         stop
      endif

      ! Verify if machine or open statement are big endian

      self%isBigEndian = Big_Endian() .or. isOpenBigEndian()


   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: OpenBin_ - routine that call low level routines to open FCT type 
!                    of BAM files
!
! 
! !DESCRIPTION: Esta rotina é uma interface para abrir os arquivos binários do
!               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 OpenBin_( BFile, istat )
      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile),     intent(inout)  :: BFile
      
!
! !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_ = 'OpenBin_( ... )'

      logical           :: existe
      integer           :: iret
      character(len=64) :: msg

#ifdef DEBUG
      WRITE(stdout,'(     2A)')'Hello from ', trim(myname_)
#endif
      iret = 0
      if(present(istat)) istat = iret

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

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

      select case (trim(BFile%oMode))

         case ('R')

            if(.not.existe)then
               iret = -80
               if(present(istat))istat=iret
               nullify(BFile%uBin)
               return
            endif

            open( unit   = BFile%uBin,         &
                  file   = trim(BFile%fBin),   &
                  status = 'old',              &
                  form   = 'unformatted',      &
                  action = 'read',             &
                  access = 'stream',           &
                  iostat = iret                &
                )

           ! Get size of binary head file
           read( unit   =  BFile%uBin, & 
                 POS    =  1,          &
                 iostat =  iret,       &
                 iomsg  =  msg         &
               ) BFile%BHeadSize

           BFile%BHeadSize = BFile%BHeadSize+2*BFile%ioSize

           if (iret.ne.0)then
              write(stdout,*)trim(myname_),': error to read head of BAM binary file, ',iret
              write(stdout,*)trim(myname_),':',trim(msg)
              if(present(istat)) istat = iret
           endif
         

         case ('W')

            if(existe)then
               write(6,'(A)')'Overwriting existing file!'
            endif

            open( unit   = BFile%uBin,         &
                  file   = trim(BFile%fBin),   &
                  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%ffct),iret
         if(present(istat))istat=iret
         return
      endif

   endsubroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: OpenHeader_ - routine that call low level routines to open Header 
!                    of BAM files (dir, dic or din)
!
! 
! !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 OpenHeader_( BFile, istat )
      implicit none
!
! !INPUT PARAMETERS:
!
      ! BAM file structure
      type(BAMFile),     intent(inout)  :: BFile
      
! !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

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

      if(present(istat)) istat = 0

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

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

!      select case (trim(md))
!
!         case ('R')

            if(.not.existe)then
               iret = -80
               if(present(istat))istat=iret
               nullify(BFile%uHead)
               return
            endif

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

!         case ('W')
!
!            if(existe)then
!               write(stdout,'(A26)')'Overwriting existing file!'
!            endif
!
!            open(unit   = BFile%uHead,       &
!                 file   = trim(BFile%fHead), &
!                 status = 'new',             &
!                 action = 'write',           &
!                 form   = 'formatted',       &
!                 iostat = iret               &
!                )
!
!      end select

      if (iret.ne.0)then
!         write(6,'(A,1x,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 MiscMod, ONLY: GetLongitudes, GetGaussianLatitudes, GetImaxJmax
      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(kind=i4), parameter :: iosize = 4 ! single precision file

      integer(kind=i4) :: k
      integer(kind=i4) :: iret
      integer(kind=i4) :: icol, isum
      integer(kind=i8) :: pmark
      integer(kind=i4) :: lastSize
      integer(kind=i4) :: Mend
      real(kind=r8), allocatable :: glats(:)
      real(kind=r8), allocatable :: glons(:)

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

      rewind(BFile%uHead)

      read (BFile%uHead,'(A21)') BFile%ittl
      
      BFile%isHybrid = check('hibrid',BFile%ittl)

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


      if (BFile%isHybrid)then
         read (BFile%uHead,'(2A150)') BFile%jttl
         read (BFile%jttl(61:62),*)BFile%LSM
         read (BFile%jttl(69:70),*)BFile%PBL

         allocate(BFile%ak(BFile%kmax))
         allocate(BFile%bk(BFile%kmax))

         ! reverse coefficients to be from top to bottom
         ! This reverse order is just at model environment
         ! GANL and GFCT files aren't in reverse order.
         ! But at output dir file these coeffients are in 
         ! reverse order to. So we need, by now, reverse to be
         ! in conform with output fields.
         ! 
         icol = 5
         isum = 0
         do while(isum .lt. BFile%kmax)

            icol = min(icol, (BFile%kmax-isum))
            !read (BFile%uHead,*)(BFile%ak(k+isum),k=1,icol)
            read (BFile%uHead,*)(BFile%ak(BFile%kmax-(k+isum)+1),k=1,icol)
            isum = isum + icol

         enddo

         icol = 5
         isum = 0
         do while(isum .lt. BFile%kmax)

            icol = min(icol, (BFile%kmax-isum))
            !read (BFile%uHead,*)(BFile%bk(k+isum),k=1,icol)
            read (BFile%uHead,*)(BFile%bk(BFile%kmax-(k+isum)+1),k=1,icol)
            isum = isum + icol

         enddo
         
         ! This is only necessary for BAM Hybrid model 
         ! Parameter kmax from DIR file have the total numbers of
         ! the hybrid levels so we need subtract one to get the 
         ! BAM vertical levels

         BFile%kmax = BFile%kmax - 1

         !
         ! vertical coordinate info
         !

         BFile%idvc = 2
         BFile%idsl = 0

      else

         read (BFile%uHead,'(2A41)') BFile%jttl, BFile%specal
         !
         ! Na versão sigma do modelo esses parametros não estão
         ! no arquivo DIR. Além disso o GSI so foi testado com
         ! o modelo SSiB.
         !
         BFile%LSM = 1
         BFile%PBL = -1

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

         icol = 5
         isum = 0
         do while(isum .lt. BFile%kmax)
            icol = min(icol, (BFile%kmax-isum))
            READ (BFile%uHead,*) (BFile%delSig(k+isum),k=1,icol)
            isum = isum + icol
         enddo
!--------------------------------------------------------------------------------------!

         allocate(BFile%SigMid(BFile%kmax),stat=iret)
         allocate(BFile%SigInt(BFile%kmax+1),stat=iret)
   
         call setsig(&
                     BFile%SigInt, & ! sigma value at each interface.
                     BFile%SigMid, & ! sigma value at midpoint of each layer
                     BFile%DelSig  & ! sigma spacing for each layer.
                    )
         !
         ! vertical coordinate info
         !

         BFile%idvc = 1
         BFile%idsl = 1
         
      endif

      allocate(BFile%root,stat=iret)
      BFile%flds => BFile%root
      BFile%fcount = 0

      !
      ! pmark and LastSize are used to obtain start point to read a forecast
      ! BAM file. We assume that BAM file has a header of size iosize + 10*iosize + iosize bytes 
      ! (at a single precision iosize = 4). We start read before header!
      !
      BFile%BHeadSize = 0
      BFile%iosize    = iosize

      pmark     = 0
      LastSize  = 0
!      LastSize  = iosize + 10*iosize + iosize
      
!      if (trim(BFile%ftype) .eq. 'unf')then
!         if (BFile%isHybrid)then
!            LastSize = LastSize +  BFile%iosize * ( 2 * (BFile%kmax+1) )
!         else
!            LastSize = LastSize + BFile%iosize * ( 2* BFile%kmax + 1 )
!         endif 
!      endif

      do
         read (BFile%uHead,'(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
         !
         ! Obtain Position marker to read directly a BAM forescast file.
         ! We assume that the integer value occupies a 32-bit (4-byte)
         ! for a single precision file and 64-bit (8-byte) for a double
         ! precion
         !
         
         pmark            = pmark + LastSize
         BFile%flds%pmark = pmark + (iosize + 1)
         
         LastSize         = (BFile%flds%nharm*BFile%iosize+BFile%iosize*2) * BFile%flds%nlevs
         
         ! allocate next field information
         allocate(BFile%flds%next,stat=iret)
         BFile%flds => BFile%flds%next

         BFile%fcount = BFile%fcount + 1
      enddo

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

35    continue

      !
      ! Init Grid and Spectral parameters
      !

      Mend = BFile%mMax-1
      if (BFile%initSpec)then
         call BFile%initTransform(Mend)
      else
         call getiMaxjMax(mEnd, BFile%xMax, BFile%yMax)
         BFile%MnWv2 = (mEnd+1)*(mEnd+2)
         BFile%MnWv0 = BFile%MnWv2 / 2
         BFile%MnWv3 = BFile%MnWv2 + 2 * (BFile%mEnd+1)
      endif
      
      !
      ! Lat/Lon informations
      !
      allocate(glats(BFile%yMax))

      call GetGaussianLatitudes(BFile%yMax,glats)

      allocate(BFile%rlat(BFile%yMax))

      BFile%rlat ( BFile%yMax:1:-1 ) = gLats ( 1:BFile%yMax )

      deallocate(glats)

      allocate(glons(BFile%xMax))
      call GetLongitudes(BFile%xMax,0.0_r8, glons)
      
      allocate(BFile%rlon(BFile%xMax))

      BFile%rlon ( 1:BFile%xMax ) = glons( 1:BFile%xMax )
      
      deallocate(glons)

      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 bamClose_(BFile, istat)

      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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
      !

      if (associated(BFile%uBin))then
         inquire(BFile%uBin, opened=isopen)
      else
         isopen = .false.
      endif

      if(isopen) then 
         close(BFile%uBin, STATUS='KEEP', iostat=iret)
         if(iret.ne.0)then
            write(*,'(3(1x,A))')trim(myname_),': ERROR to close file',trim(BFile%fBin)
            if(present(istat)) istat = iret
         endif
         nullify(BFile%uBin)
         BFile%fBin = ''
      endif

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

         nullify(BFile%uHead)
         BFile%fHead = ''

         !
         ! reset all header data
         !

         call ResetHead_(BFile)

         !
         ! reset transfom data
         !

         if (bFile%initSpec) call BFile%destroyTransform( )

         !
         ! 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_()'
      integer :: iret

      BFile%ittl  = ''
      BFile%jttl  = ''
      BFile%sdain = ''
      BFile%dtin  = ''
      BFile%trunc = ''
      BFile%nexp  = -1
      BFile%mMax  = -1
      BFile%MnWv2 = -1
      BFile%MnWv3 = -1
      BFile%kmax  = -1
      BFile%ihr   = -1
      BFile%idy   = -1
      BFile%imo   = -1
      BFile%iyr   = -1
      BFile%fhr   = -1
      BFile%fdy   = -1
      BFile%fmo   = -1
      BFile%fyr   = -1

      if(associated(BFile%delsig))&
                deallocate(BFile%delsig)

      if(associated(BFile%SigInt))&
                deallocate(BFile%SigInt)

      if(associated(BFile%SigMid))&
                deallocate(BFile%SigMid)

      if(associated(BFile%rlon))&
                deallocate(BFile%rlon)

      if(associated(BFile%clon))&
                deallocate(BFile%clon)

      if(associated(BFile%slon))&
                deallocate(BFile%slon)

      if(associated(BFile%rlat))&
                deallocate(BFile%rlat)

      if(associated(BFile%clat))&
                deallocate(BFile%clat)

      if(associated(BFile%slat))&
                deallocate(BFile%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 bamGetOneDim_(BFile, DName) result(dim)
      
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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                          :: dim
!
! !REVISION HISTORY: 
!  11 Oct 2016 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!

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

      character(len=5) :: DimName

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

      select case (DimName)
         case ('imax','xmax','lon')
            dim = BFile%xMax
         case ('jmax','ymax','lat')
            dim = BFile%yMax
         case ('kmax','zmax','lev')
            dim = BFile%KMax
         case ('mend')
            dim = BFile%mMax - 1
         case ('mnwv2')
            dim = BFile%MnWv2
         case ('mnwv3')
            dim = BFile%MnWv3
         case default
            write(*,'(4A)')trim(myname_),': wrong dimension <',trim(DimName),'>'
            write(*,'( A)')'try: <imax,xmax,lon>, <jmax,ymax,lat>, <kmax,zmax,lev>, 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 bamGetTimeInfo_(BFile, DName) result(dt)
      
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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                          :: 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%iyr
         case ('imo')
            dt = BFile%imo
         case ('idy')
            dt = BFile%idy
         case ('ihr')
            dt = BFile%ihr
         case ('fyr')
            dt = BFile%fyr
         case ('fmo')
            dt = BFile%fmo
         case ('fdy')
            dt = BFile%fdy
         case ('fhr')
            dt = BFile%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 bamGetDims_(BFile, Imax, Jmax, Kmax, Mend, istat)

      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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( ... )'
     
      if(present(istat)) istat = 0

      IMax  = BFile%xMax
      JMax  = BFile%yMax
      KMax  = BFile%KMax
      Mend  = BFile%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 bamGetNlevels_(BFile,VName,istat) result(nlevs)

      implicit none

!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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: GetOFS_ - return Original field Size.
!
!
! 
! !DESCRIPTION: Rotina que retorma o tamanho original do campo do BAM.
!               Se o campo estiver no espaço espectral retornará 
!               (Mend+1)*(Mend+2), caso esteja no espaço físico, retornará
!               IMax*JMax.
!               
!
! !INTERFACE:
!

   function bamGetOFS_(BFile,VName,istat) result(OFSize)

      implicit none

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

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

      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)))

      OFSize = -1

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

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

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

         fld => fld%next
      enddo

      if(OFSize .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: bamGetPhysics - return physical scheme used by BAM model
!
! 
! !DESCRIPTION: Esta rotina retorna um valor inteiro referente à opção física
!               utilizada pelo modelo BAM. As seguintes informacões são disponíveis:
!
!              1. lsm : esquema de superfície utillizado (1-SSiB, 2-SiB2, 3-IBIS)
!              2. pbl : esquema de camada linite utilizao ()
!
! !INTERFACE:
!

   function bamGetPhysics_(BFile, what)result(scheme)
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(BAMFile)   :: BFile

      ! Name of inquired physic type scheme
      character(len=*) :: what
      ! 
      ! Can be:     
      !       1. lsm : esquema de superfície utillizado
      !       2. pbl : esquema de camada limite utilizao

!
! !OUTPUT PARAMETERS:
!
      integer(i4) :: scheme
!
! !REVISION HISTORY: 
!  25 Mar 2021 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
      character(len=100) :: inquired

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

      inquired = lcase(what)

      select case(trim(inquired))
         case('pbl')
            scheme = BFile%pbl
         case('lsm')
            scheme = BFile%lsm
         case('idvc')
            scheme = BFile%idvc
         case('idsl')
            scheme = BFile%idsl
         case default
            write(*,'(4A)')trim(myname_),': physics type not yeat implemented ! <',trim(Inquired),'>'
            scheme = -1
      end select
   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  bamGetWCoord_(BFile, what, coord, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(BAMFile),     intent(in   ) :: BFile

      ! Name of inquired World 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

      if (present(istat)) istat = 0

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

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%xMax
            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
               if (present(istat)) istat = -1
               return
            endif

            coord = BFile%rlon

         case('slon') ! sine of longitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%xMax
            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
               if (present(istat)) istat = -1
               return
            endif

            coord = sin(BFile%rlon/rd)

         case('clon') !cosine of longitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%xMax
            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
               if (present(istat)) istat = -1
               return
            endif

            coord = cos(BFile%rlon/rd)

         case('rlat','lat') ! real latitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%yMax
            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
               if (present(istat)) istat = -1
               return
            endif

            coord = BFile%rlat

         case('slat') ! sine of latitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%yMax
            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
               if (present(istat)) istat = -1
               return
            endif

            coord = sin(BFile%rlat/rd)

         case('clat') ! cosine of latitude

            !check consistensy
            lenIn = size(coord)
            lenOu = BFile%yMax
            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
               if (present(istat)) istat = -1
               return
            endif

            coord = cos(BFile%rlat/rd)

         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

      return

   end subroutine
!
!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 bamGetVerticalCoord_(BFile, what, vcoord, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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
   
      if(present(istat)) istat = 0

      vcn = ucase(trim(what))

      !Sanity Check

      select case (trim(vcn) )
         case ('AK', 'BK', 'CK')
            if ( .not. BFile%isHybrid)then
               write(stdout,'(2(1x,A))')trim(myname_),': ak, bk or ck are just for Hybrid-sigma vertical coordinate'
               if(present(istat))istat = -2
               vcoord = undef
               return
            endif

         case ('SI', 'SL', 'DL')
            if (BFile%isHybrid)then
               write(stdout,'(2(1x,A))')trim(myname_),': si, sl or dl are just for Sigma vertical coordinate'
               if(present(istat))istat = -2
               vcoord = undef
               return
            endif
         case default
            write (stdout,'(3(1x,A))')trim(myname_),': unknown requested parameter,:',trim(vcn)
            if(present(istat))istat = -1
      end select

      select case (trim(vcn))
         case ( 'AK' )
            vcoord = BFile%ak
         case ( 'BK' )
            vcoord = BFile%bk
         case ( 'CK' )
            vcoord = BFile%ck
         case ( 'SI' )
            vcoord = BFile%SigInt
         case ( 'SL' )
            vcoord = BFile%SigMid
         case ( 'DL' )
            vcoord = BFile%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 bamGetSigValues_(BFile, DelSig, SigInt, SigMid, istat)
      implicit none
!
! !INPUT PARAMETERS:
!      
      ! BAM file structure
      class(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%DelSig
      SigInt = BFile%SigInt
      SigMid = BFile%SigMid


   end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IFUNCTION: bamGetnFields_ - return the total number of fields in the BAM File
!
! 
! !DESCRIPTION: Esta funcão retorna o numero total de campos disponíveis no 
!               arquivo do modelo bam
!
!
! !INTERFACE:
!
function  bamGetnFields_(self) result(nFields)

!
! !INPUT PARAMETERS:
!
   class(BAMFile), intent(in) :: self

!
! ! OUTPUT PARAMETERS:
!
   integer :: nFields
!
! !REVISION HISTORY: 
!  21 July 2021 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
   character(len=100), parameter :: myname_=':: bamGetnFields_( ... )'

   type(BAM_fld), pointer :: fields => null()
   integer       :: i

   nFields = self%fcount
   
   return

end function
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IFUNCTION: bamGetVarNames_ - return a table with all variable names
!
! 
! !DESCRIPTION: Esta funcão retorna uma tabela contendo todas as variáveis
!               disponíveis no arquivo do modelo bam
!
!
! !INTERFACE:
!
subroutine  bamGetVarNames_(self,table)

!
! !INPUT PARAMETERS:
!
   class(BAMFile), intent(in) :: self

!
! ! OUTPUT PARAMETERS:
!
   character(len=*), allocatable :: table(:)
!
! !REVISION HISTORY: 
!  28 Apr 2021 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
   character(len=100), parameter :: myname_=':: bamGetVarNames_( ... )'

   type(BAM_fld), pointer :: fields => null()
   integer       :: i, isize

   if(.not.allocated(table))then
      allocate(table(self%fcount))
   else
      isize = size(table)
      if (isize .ne. self%fcount)then
         write(stdout,*)trim(myname_),': error to get varnames!'
         write(stdout,*)'wrong size of varnames array'
         write(stdout,*)'shoud be', self%fcount,'but is',isize
         stop
      endif
   endif
   fields => self%root
   do i=1,self%fcount
      table(i) = trim(fields%name)
      fields => fields%next
   enddo
   return

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, iosize, fosize) 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 ? 
      integer,           intent(in   ) :: iosize! size of record markers
!
! !RETURN VALUE:
!
      integer, intent(out) :: fosize
      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

!      real, allocatable :: tst(:)
!      integer           :: isize, osize, i, tmpsize

      !
      ! 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
      ! Here we need skip header from BAM fct file
      ! to get initial position of first field!
      ! Head have a 10 positions!
      !
      ! NOTA: Fortran typically puts a size header at the 
      !       start and end of the data, in this case it 
      !       is using 4 byte record markers. So we need
      !       add 8 bytes to idx
      !       Add iosize is the size of record markers

      idx = 10*BFile%iosize + BFile%iosize*2
      if (trim(BFile%ftype) .eq. 'unf')then
         idx = idx + BFile%iosize * (2*BFile%kmax + 1)
      endif
      !
      ! ----------------------------------------------
      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 = idx + (wlev-1)*(fld%nharm*BFile%iosize + BFile%iosize*2)
             fosize = fld%nharm

            exit

         else

            idx = idx + (fld%nharm*BFile%iosize+BFile%iosize*2)*fld%nlevs

         endif

         fld => fld%next
      enddo

      idx = idx + (BFile%iosize + 1)

   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(self, wfld, wlev, grd, mEnd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
      integer, optional, intent(in   ) :: mEnd  ! what truncation?
!
! !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 self%DGetFLD_1D(wfld, wlev, TmpGrd, mEnd=mEnd, istat=iret)
      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(self, wfld, wlev, grd, mEnd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self  ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ?
      integer, optional, intent(in   ) :: mEnd  ! what truncation?
!
! !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 self%DGetFLD_2D(wfld, wlev, TmpGrd, mEnd=mEnd, istat=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(self, wfld, wlev, grd, mEnd, istat)

      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self  ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ?
      integer, optional, intent(in   ) :: mEnd  ! what truncation?
!
! !OUTPUT PARAMETERS:
! 
      real(r8),          intent(inout) :: grd(:,:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!    DGetFLD_2D( ) - 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 self%DGetFLD_1D(wfld, wlev, fld, mEnd=mEnd, istat=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(self, wfld, wlev, grd, mEnd, istat)
      use MiscMod, only: getiMaxjMax, lterp
      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self  ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
      integer, optional, intent(in   ) :: mEnd  ! what truncation?
!
! !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 :: iret

      type(BAM_fld), pointer :: fld

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

      integer :: iMax
      integer :: jMax
      integer :: jcap
      integer :: Mnwv2

      integer :: i, j, k
      integer :: js, jn
      integer :: ijs, ijn
      integer :: ii, jj
      integer :: ioffset
      integer :: iMax_c, jMax_c
      integer(I8) :: idx
      integer :: npts

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

      character(len=80) :: linha
      character(len=1024) :: acc, fmt

      if(present(istat)) istat = 0

      if (.not.self%initSpec)then
         call pwrn(myname_,'Spectrans not initializated!','Can get only spectral fields')
      endif

      if (.not. associated(self%uBin))then
         write(stdout,*)''
         write(stdout,*)'!!! WARNING !!!'
         write(stdout,*)'Binary file not opened!'
         write(stdout,*)'You can not get a field!'
         write(stdout,*)''
         write(stdout,*)'Review the options of the model OPEN statment!'
         write(stdout,*)''
         write(stdout,*)'Binary File: <empty>'
         write(stdout,*)'Header File:',trim(self%fHead)
         write(stdout,*)'Open mode  :',trim(self%oMode)
         write(stdout,*)''


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

      !
      ! get BAM file dimensions
      !

      iMax  = self%GetOneDim('iMax')
      jMax  = self%GetOneDim('jMax')
      jcap  = self%GetOneDim('Mend')
      MnWv2 = self%GetOneDim('MnWv2')

      if (present(mEnd))then
         if (mEnd .gt. jcap)then
            call perr(trim(myname_),'mEnd > jcap')
            write(stderr,*) 'mEnd =', mEnd, 'jcap =', jcap
            write(stdout,*)''
            write(stdout,*)'You can not get a field!'
            write(stdout,*)''
            write(stdout,*)'Review the mEnd and try again'
            if(present(istat)) istat = -1
            return
         endif
      endif

      !
      ! back to begin of file
      !

      rewind(self%uBin) 


      !
      ! Find BAM Field and get bit position and real size
      !
      
      idx = -1
      InqName = Trim(adjustl(lcase(wfld)))

      fld => self%root
      do ifld = 1, self%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 = self%BHeadSize + fld%pmark + ( (wlev-1)*(fld%nharm*R4 + R4*2))
            
            exit

         endif

         fld => fld%next
      enddo

      if (idx .lt. 0)then
         call perr(trim(myname_),'Field Not Found ...['//trim(self%fBin)//' ]')
         if(present(istat))istat = idx
         return
      endif

      !
      ! Get Field
      !
      allocate(bufs(fld%nharm))
      call ReadField (self%uBin, bufs, self%isBigEndian, idx, iret)
      if (iret.ne.0)then
         if(present(istat)) istat = iret
         write(stdout,*)trim(myname_),': error to read file ::','['//trim(self%fBin)//' ], ',iret
      endif

      npts = size(grd)

      !
      ! this case is for original bam fields:
      !
      !  * return spectral fields on spectral space
      !  * return not spectral fields
      !
      if (npts .eq. fld%nharm)then
         grd = real(bufs,r8)
      else

         if (present(mEnd))then
            call getiMaxjMax(mEnd, iMax_c, jMax_c)
         else
            iMax_c = iMax
            jMax_c = jMax
         endif
         !
         ! sanity check
         !
         if (jMax_c .ne. jMax)then
            call perr(myname_,'Some wrong with dimensions!')
            write(stderr,*)'Verify specTrans initialization!'
            write(stderr,*)'jMax wrong:',jMax_c,'!=',jMax
            stop 1
         endif
   
         if (npts .ne. iMax_c*jMax_c)then
            call perr(myname_,'Some wrong with dimensions!')
            write(stderr,*)'Verify specTrans initialization!'
            write(stderr,*)'iMax*jMax wrong:',iMax*jMax,'!=',npts
            write(stderr,*)'iMax:',npts/jMax
            write(stderr,*)'jMax:',jMax
            stop 2
         endif
         !---------------------------------------------!

         if (fld%nharm .eq. MnWv2)then
            ! if mEnd .ne. jcap this will interpolate
            ! jcap truncation to mEnd
            !
            allocate (bufx (mnwv2))
   
            bufx(1:mnwv2) = real(bufs(1:mnwv2),R8)
   
            deallocate(bufs)
   
            allocate (bufw (imax,jmax))
            call self%Spec2Grid(bufx,bufw)
            jn = imax_c
            js = -jn
            ioffset = imax_c*(jmax_c-1)
      
            do j=1, (jmax_c+1)/2
               do i=1,imax_c
                  ii  = imax/imax_c*(i-1)+1
                  jj  = j - 1
                  ijn = i + jj*jn
                  ijs = i + jj*js + ioffset 
                  grd(ijn) = bufw(ii,       j)
                  grd(ijs) = bufw(ii,jMax-j+1)
               enddo
            enddo

            deallocate(bufw)

         else
            call getiMaxjMax(jcap, iMax, jMax)
            allocate(buft(iMax,jMax))
            k = 1
            do j=1,jMax
               do i=1,iMax
                  buft(i,j) = bufs(k)
                  k = k + 1
               enddo
            enddo
            deallocate(bufs)

            allocate(bufw(iMax_c,jMax_c))
            call lterp(buft, jcap, mEnd, bufw )

            k = 1
            do j = 1, jMax_c
               do i = 1, iMax_c
                  grd(k) = bufw(i,j)
                  k = k + 1
               enddo
            enddo   
            deallocate(bufw)

         endif

      endif
!
!
!      if ( ( npts .eq. (IMax*JMax) ) .and. (fld%nharm .eq. mnwv2 ) .and. self%initSpec) 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 self%Spec2Grid(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

      return

   end subroutine

!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: getOrigField_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 getOrigField_1D(self, wfld, wlev, fldOut, istat)
      use MiscMod, only: getiMaxjMax, lterp
      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self  ! file information
      character (len=*), intent(in   ) :: wfld  ! what field name ?
      integer,           intent(in   ) :: wlev  ! what field level ? 
!
! !OUTPUT PARAMETERS:
! 
      real(r4),          intent(inout) :: fldOut(:)
      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 :: iret

      type(BAM_fld), pointer :: fld

      real (R4), dimension (:),   allocatable :: bufs

      integer     :: isize
      integer(I8) :: idx


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

      if(present(istat)) istat = 0

      if (.not. associated(self%uBin))then
         write(stdout,*)''
         write(stdout,*)'!!! WARNING !!!'
         write(stdout,*)'Binary file not opened!'
         write(stdout,*)'You can not get a field!'
         write(stdout,*)''
         write(stdout,*)'Review the options of the model OPEN statment!'
         write(stdout,*)''
         write(stdout,*)'Binary File: <empty>'
         write(stdout,*)'Header File:',trim(self%fHead)
         write(stdout,*)'Open mode  :',trim(self%oMode)
         write(stdout,*)''
         if(present(istat)) istat = -1
         return
      endif

      !
      ! back to begin of file
      !

      rewind(self%uBin) 

      !
      ! Find BAM Field and get bit position and real size
      !
      
      idx = -1
      InqName = Trim(adjustl(lcase(wfld)))

      fld => self%root
      do ifld = 1, self%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 = self%BHeadSize + fld%pmark + ( (wlev-1)*(fld%nharm*R4 + R4*2))
            
            exit

         endif

         fld => fld%next
      enddo

      if (idx .lt. 0)then
         call perr(trim(myname_),'Field Not Found ...['//trim(self%fBin)//' ]')
         if(present(istat))istat = idx
         return
      endif

      !
      ! sanity check for output field size
      !

      isize = size(fldOut)
      if (isize .ne. fld%nharm)then
         write(stdout,*)''
         write(stdout,*)'!!! ERROR !!!'
         write(stdout,*)'Wrong size of output field'
         write(stdout,*)'Trying get ',isize
         write(stdout,*)'but was found ', fld%nharm
         if(present(istat)) istat = -1
         return
      endif

      !
      ! Get Field
      !
!      allocate(bufs(fld%nharm))
!      call ReadField (self%uBin, bufs, self%isBigEndian, idx, iret)
      call ReadField (self%uBin, fldOut, self%isBigEndian, idx, iret)
      if (iret.ne.0)then
         if(present(istat)) istat = iret
         write(stdout,*)trim(myname_),': error to read file ::','['//trim(self%fBin)//' ], ',iret
      endif

      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, byteSwap, idx, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
      integer(i8), optional, intent(in   ) :: idx
      logical,               intent(in   ) :: byteSwap ! .true. machine is big Endian
!
! !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
      character(len=64) :: msg

      if(present(istat)) istat = 0

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

      ! if machine is little endian do byteSwap
      if (.not.byteSwap) fld = swap_endian(fld)

   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, byteSwap, idx, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
      integer(i8), optional, intent(in   ) :: idx
      logical,               intent(in   ) :: byteSwap ! .true. machine is big Endian
!
! !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

      if(present(idx))then
         read(unit = funit, POS=idx, iostat = iret) fld
      else
         read(unit = funit, iostat = iret) fld
      endif

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

      ! if machine is little endian do byteSwap
      if (.not.byteSwap) fld = swap_endian(fld)
      
   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, byteSwap,  idx, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
      integer(i8), optional, intent(in   ) :: idx
      logical,               intent(in   ) :: byteSwap ! .true. machine is big Endian
!
! !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

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

      ! if machine is little endian do byteSwap
      if (.not.byteSwap) fld = swap_endian(fld)

   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, byteSwap, idx, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
      integer(i8), optional, intent(in   ) :: idx
      logical,               intent(in   ) :: byteSwap ! .true. machine is big Endian
!
! !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

      if(present(idx))then
         read(unit = funit, POS=idx, iostat = iret) fld
      else
         read(unit = funit, iostat = iret) fld
      endif

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

      ! if machine is little endian do byteSwap
      if (.not.byteSwap) fld = swap_endian(fld)

   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, byteSwap, idx, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
      integer(i8), optional, intent(in   ) :: idx
      logical,               intent(in   ) :: byteSwap ! .true. machine is big Endian

!
! !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

      if(present(idx))then
         read(unit = funit, POS=idx, iostat = iret) fld
      else
         read(unit = funit, iostat = iret) fld
      endif

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

      ! if machine is little endian do byteSwap
      if (.not.byteSwap) fld = swap_endian(fld)
      
   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, byteSwap, idx, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      integer(i4),           intent(in   ) :: funit
      integer(i8), optional, intent(in   ) :: idx
      logical,               intent(in   ) :: byteSwap ! .true. machine is big Endian
!
! !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

      if(present(idx))then
         read(unit = funit, POS=idx, iostat = iret) fld
      else
         read(unit = funit, iostat = iret) fld
      endif

      if (iret.ne.0)then
         write(stdout,*)trim(myname_),': error to read file, ',iret
         if(present(istat)) istat = iret
      endif
      
      ! if machine is little endian do byteSwap
      if (.not.byteSwap) fld = swap_endian(fld)

   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 bamWriteAnlHeader_(self, mydate, istat)

     implicit none
!
! !INPUT PARAMETERS:
!
     class(BAMFile),    intent(in   ) :: self      ! 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

     integer(i4) :: idsl
     integer(i4) :: idvc 


     real (r8), allocatable :: del(:)
     real (r8), allocatable :: ak(:)
     real (r8), allocatable :: bk(:)

!     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  = self%GetOneDim('KMax')
    KMaxP = KMax + 1

    if (self%isHybrid)then
       allocate( ak (KMaxP) )
       allocate( bk (KMaxP) )
       call self%getVerticalCoord('ak',ak)
       call self%getVerticalCoord('bk',bk)
    else
!       allocate( del( KMax) )
       allocate( ak (KMaxP) )
       allocate( bk ( KMax) )
!       call self%GetSigValues (del, ak, bk, iret)
       call self%getVerticalCoord('si',ak)
       call self%getVerticalCoord('sl',bk)
    endif

    idvc = self%getPhysics('idvc')
    idsl = self%getPhysics('idsl')


!    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 (self%uBin, iostat = iret) ifday, tod, idate, idatec, real(ak,r4), real(bk,r4), int(idvc, i8), int(idsl,i8)
    if(present(istat)) istat = iret

!    deallocate(del)
    deallocate(ak)
    deallocate(bk)

  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:
!   
#ifdef useMPI
  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
#endif
!
!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

     if(present(istat)) istat = 0

     write( OutUnit, iostat = iret ) Field

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

     return

  end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_SendField_ -
!
! 
! !DESCRIPTION:
!
!
! !INTERFACE:
!   
#ifdef useMPI
  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
#endif
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: WriteField_MPIr4 - write fields of BAM files from a MPI Pe.
!
! 
! !DESCRIPTION: Esta rotina escreve um campo do modelo BAM 
!               
!
! !INTERFACE:
!   
#ifdef useMPI
  subroutine WriteField_MPIr4_(OutUnit, field, OutPe, iCount, istat)

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

     ! Field to be writed
     real(r4),              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_MPIr4_( ... )'

     real(r4), 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_Serialr4_(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_FLOAT, Pe, MPITag, MPI_COMM_WORLD, status, iret)

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

     end do
      
     deallocate(buff)

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

  subroutine WriteField_Serialr4_(OutUnit, Field, istat)

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

     ! Field to be writed
     real(r4),              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_Serialr4_( ... )'

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


     if(present(istat)) istat = 0

     write( OutUnit, iostat = iret ) Field

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

     return

  end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: BAM_SendField_ -
!
! 
! !DESCRIPTION:
!
!
! !INTERFACE:
!   
#ifdef useMPI
  subroutine BAM_SendFieldr4_(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(r4),              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_FLOAT, 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
#endif

!-----------------------------------------------------------------------
!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
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: check - check if the substring is contained in the string.
!
! !DESCRIPTION:
!
! !INTERFACE:

  function check(substr, str) result(found)
     character(len=*) :: substr
     character(len=*) :: str
     logical          :: found
! 	25Mar21 - J. Gerd	- (to do)
!EOP
!-----------------------------------------------------------------------

     integer :: i, istart, iend
     integer :: strLen
     integer :: subStrLen

     character(len=1024) :: string, subString 

     strLen    = len_trim(str)
     subStrLen = len_trim(substr)

     string    = lcase(str)
     subString = lcase(subStr)

     found = .false.
     do i = 1, strLen-subStrLen
        istart = i
        iend   = i+subStrLen-1
        if (trim(substring) == string(istart:iend)) found = .true.
     enddo

     
  end function

  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

  subroutine perr2_(where, message, cod)
     implicit none
     character(len=*), intent(in) :: where
     character(len=*), intent(in) :: message
     integer,          intent(in) :: cod

     write(stderr,'(4A,1x,I4)')'Error at ',trim(where),' : ', trim(message),cod

  end subroutine

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

     write(stdout,'(4A)')'WARNING ',trim(where),' : ', trim(message)

  end subroutine

  subroutine pwrn2_(where, message1, message2)
     implicit none
     character(len=*), intent(in) :: where
     character(len=*), intent(in) :: message1, message2

     integer :: isize
     character(len=60) :: fmt

     isize=len_trim(where)
     write(fmt,'(A,I3.1,A)') '(A7,1x,A',isize,',1x,A,/,11x,A,/,11x,A)'
     write(stdout,fmt)'WARNING ',trim(where),' : ', trim(message1),trim(message2)
     

  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

         if(iunit .eq. MaxLogicalUnit)then
            call perr(trim(myname_),'Units from 10 to 254 are already in use!')
            stop
         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
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: getUV - routine to get U and V components of wind.
!
! 
! !DESCRIPTION: Esta rotina é utilizada para obter os campos de u e v do modelo 
!               BAM.
!               Nesta rotina são lidas as variáveis diverfencia e vorticidade,
!               e, logo após, estes campos são convetidos nas componentes zonal
!               e meridional do vento.
!
! !INTERFACE:

  subroutine getUV2D_(self, wlev, uvel, vvel, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self  ! file information
      integer,           intent(in   ) :: wlev  ! what field level ? 

!
! !OUTPUT PARAMETERS:
! 
      real(r8),          intent(  out) :: uvel(:,:)
      real(r8),          intent(  out) :: vvel(:,:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!
!
!
! !REVISION HISTORY: 
!
!  20 Aug 2019 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
     real(r8), allocatable :: uwind(:)
     real(r8), allocatable :: vwind(:)
     integer :: ipt, jpt, iret

     ipt = size(uvel,1)
     jpt = size(uvel,2)

     allocate(uwind(ipt*jpt))
     allocate(vwind(ipt*jpt))

     call self%getUV1D_(wlev, uwind, vwind, iret)

     uvel = reshape(uwind,[ipt,jpt])
     vvel = reshape(vwind,[ipt,jpt])

     if(present(istat)) istat = iret

  end subroutine
!EOC
!-----------------------------------------------------------------------------!
!             Modeling and Development Division - DMD/CPTEC/INPE              !
!-----------------------------------------------------------------------------!
!
!BOP
!
! !IROUTINE: getUV - routine to get U and V components of wind.
!
! 
! !DESCRIPTION: Esta rotina é utilizada para obter os campos de u e v do modelo 
!               BAM.
!               Nesta rotina são lidas as variáveis diverfencia e vorticidade,
!               e, logo após, estes campos são convetidos nas componentes zonal
!               e meridional do vento.
!
! !INTERFACE:

  subroutine getUV1D_(self, wlev, uvel, vvel, istat)
      implicit none
!
! !INPUT PARAMETERS:
! 
      class(BAMFile),    intent(in   ) :: self ! file information
      integer,           intent(in   ) :: wlev ! what field level ? 

!
! !OUTPUT PARAMETERS:
! 
      real(r8),          intent(  out) :: uvel(:)
      real(r8),          intent(  out) :: vvel(:)
      integer, optional, intent(  out) :: istat
!
! !SEE ALSO:
!
!
!
!
! !REVISION HISTORY: 
!
!  14 Aug 2019 - J. G. de Mattos - Initial Version
!
!
!EOP
!-----------------------------------------------------------------------------!
!BOC
!
!     type(legendre) :: leg
     integer :: iMax
     integer :: jMax
     integer :: MnWv2
     integer :: MnWv3
     integer :: iret

     real(r8), dimension(:),   allocatable :: divq
     real(r8), dimension(:),   allocatable :: vorq
     real(r8), dimension(:),   allocatable :: uveq
     real(r8), dimension(:),   allocatable :: vveq
     real(r8), dimension(:,:), allocatable :: buft
     real(r8), dimension(:,:), allocatable :: bufw

     !
     ! get BAM file dimensions
     !

     iMax  = self%GetOneDim('iMax')
     jMax  = self%GetOneDim('jMax')
     MnWv2 = self%GetOneDim('MnWv2')
     MnWv3 = self%GetOneDim('MnWv3')

     !
     ! Get Divergence and Vorticity
     !

     allocate(divq(MnWv2))
     allocate(vorq(MnWv2))
     call self%getField('DIVERGENCE', wlev, divq, iret)
     if(present(istat)) istat = iret
     call self%getField('VORTICITY' , wlev, vorq, iret)
     if(present(istat)) istat = istat + iret


     !
     ! Transform to uvel and vvel
     !

     allocate(uveq(MnWv3))
     allocate(vveq(MnWv3))

     call self%DivgVortToUV(divq, vorq, uveq, vveq)
     deallocate(divq)
     deallocate(vorq)


     if(size(uvel) .eq. (iMax*jMax))then

!        call createFFT (iMax)
        
        !
        ! UVEL
        !

        allocate (bufw (imax,jmax))
        call self%Spec2Grid(uveq,bufw)
        deallocate(uveq)

        uvel = reshape(bufw,[size(uvel)])
        deallocate(bufw)

        !
        ! VVEL
        !

        allocate (bufw (imax,jmax))
        call self%Spec2Grid(vveq,bufw)
        deallocate(vveq)

        vvel = reshape(bufw,[size(vvel)])
        deallocate(bufw)

     else

        uvel = uveq
        vvel = vveq

        deallocate(uveq)
        deallocate(vveq)

     endif

  end subroutine
!
!EOC
!
!-----------------------------------------------------------------------------!


end module sigio_bammod
