MODULE input_module

   USE gridinfo_module
   USE misc_definitions_module
   USE module_debug
   USE module_model_basics
   USE queue_module
#ifdef IO_BINARY
   USE module_internal_header_util
#endif
 
 
   ! WRF I/O API related variables
   integer                             :: handle
 
   type (queue)                        :: unit_desc
   integer                             :: num_calls, iatts
   character (len=200), dimension(200) :: catts

   CONTAINS
 
 
   SUBROUTINE input_init (file_number, istatus)
 
      implicit none

#include "wrf_io_flags.h"
#include "wrf_status_codes.h"
  
      ! Arguments
      integer, intent(in)  :: file_number
      integer, intent(out) :: istatus
  
      ! Local variables
      character (len=128)  :: input_fname
  
      istatus = 0
      CALL arw_ioinit(istatus)
     
      istatus = 0
      input_fname = ' '
      input_fname = trim(input_file_names(file_number))
      CALL arw_open_for_read(input_fname, handle, istatus)
     
      CALL q_init(unit_desc)
  
      num_calls = 0
 
   END SUBROUTINE input_init
 
 
   SUBROUTINE read_next_field (domain_start, domain_end, &
                               cname, cunits, cdesc, memorder, &
                               stagger, dimnames, real_array, valid_date, istatus)
 
      implicit none

#include "wrf_io_flags.h"
#include "wrf_status_codes.h"
  
      ! Arguments
      integer, dimension(3)             :: domain_start, domain_end
      real, pointer, dimension(:,:,:)   :: real_array
      character (len=*), intent(out)    :: cname, memorder, stagger, cunits, cdesc
      character (len=128), dimension(3) :: dimnames
      integer, intent(inout)            :: istatus
  
      ! Local variables
      integer                           :: ndim, wrftype
      real, pointer, dimension(:,:,:)   :: real_domain
      character (len=19)                :: valid_date
      type (q_data)                     :: qd
  

      num_calls = num_calls + 1
      domain_start = 1
      domain_end   = 1

#ifdef IO_NETCDF
      IF (io_form_input == NETCDF) THEN
        CALL arw_get_next_var(handle, cname, istatus) 
      END IF
#endif
      if (istatus /= 0) return
 
      istatus = 0
      CALL arw_get_var_info(handle, cname, ndim, memorder, stagger, cdesc, cunits, domain_start, domain_end, wrftype, istatus)
      if (istatus /= 0) return
      if (ndim == 0) return
      if (ndim /= 3) then
         domain_start(3) = 1
         domain_end(3) = 1
      end if

     
      IF ( ASSOCIATED(real_array) ) DEALLOCATE(real_array)
      IF ( ASSOCIATED(real_domain) ) DEALLOCATE(real_domain)
      ALLOCATE(real_domain(domain_end(1), domain_end(2), domain_end(3)))
      CALL arw_read_field(handle, valid_date, cname, real_domain, wrftype, &
                          memorder, stagger, dimnames, domain_start, domain_end, istatus)

     
         if (io_form_input == BINARY) then
            qd = q_remove(unit_desc)
            cunits  = qd%units
            cdesc   = qd%description
         else
        
#ifdef IO_NETCDF
            if (io_form_input == NETCDF) then
               CALL ext_ncd_get_var_ti_char(handle, 'units', cname, cunits, istatus)
               CALL ext_ncd_get_var_ti_char(handle, 'description', cname, cdesc, istatus)
            end if
#endif
!!#ifdef IO_GRIB1
!!          if (io_form_input == GRIB1) then
!!             CALL ext_gr1_get_var_ti_char(handle, 'units', cname, cunits, istatus)
!!             CALL ext_gr1_get_var_ti_char(handle, 'description', cname, cdesc, istatus)
!!          end if
!!#endif

         end if

      IF (len_trim(cdesc) == 1 ) cdesc = cname     !!! Because .ctl must have a description

      real_array => real_domain
 
   END SUBROUTINE read_next_field
 
   SUBROUTINE read_spec_field (domain_start, domain_end, cname, wrftype, memorder, &
                               stagger, dimnames, real_array, valid_date, istatus)
 
      implicit none

#include "wrf_io_flags.h"
#include "wrf_status_codes.h"
  
      ! Arguments
      integer, dimension(3)             :: domain_start, domain_end
      real, pointer, dimension(:,:,:)   :: real_array
      character (len=*), intent(in)     :: memorder, stagger
      character (len=*), intent(in)     :: cname
      character (len=128), dimension(3) :: dimnames
      integer, intent(inout)            :: istatus
  
      ! Local variables
      integer                           :: ndim, wrftype
      real, pointer, dimension(:,:,:)   :: real_domain
      character (len=19)                :: valid_date
      type (q_data)                     :: qd
  

      istatus = 0
   
      IF ( ASSOCIATED(real_domain) ) DEALLOCATE(real_domain)
      IF ( ASSOCIATED(real_array) ) DEALLOCATE(real_array)

!!      IF ( ASSOCIATED(real_domain) ) DEALLOCATE(real_domain)
!      nullify(real_domain) ! Bug fix
!      IF ( ASSOCIATED(real_array) ) DEALLOCATE(real_array)


      ALLOCATE(real_domain(domain_end(1), domain_end(2), domain_end(3)))
      CALL arw_read_field(handle, valid_date, cname, real_domain, wrftype, &
                          memorder, stagger, dimnames, domain_start, domain_end, istatus)


      real_array => real_domain
 
   END SUBROUTINE read_spec_field
 
   
   SUBROUTINE read_global_attrs ()
 
      implicit none
  
      ! Local variables
      integer                          :: dyn_opt
      integer                          :: outcount, istatus
      character (len=19)               :: start_date
      character (len=128)              :: grid_type
      character (len=128)              :: cunits, cdesc, cstagger, mminlu
      type (q_data)                    :: qd
      real                             :: dum_r
      integer                          :: dum_i
  
      iatts = 0
      
      iprogram = 8
      CALL arw_get_gbl_att_char(handle, 'TITLE', title, istatus)
      IF ( INDEX(title,'OUTPUT FROM WRF SI') /= 0 ) iprogram = 0  !! WRFSI output
      IF (trim(title) == 'OUTPUT FROM GRIDGEN') iprogram = 1      !! geogrid output 
      IF (trim(title) == 'OUTPUT FROM METGRID') iprogram = 3      !! metgrid output
      IF ( INDEX(title,'OUTPUT FROM REAL_EM') /= 0 ) iprogram = 6 !! real.exe output

      CALL arw_get_gbl_att_char(handle, 'SIMULATION_START_DATE', start_date, istatus)
      CALL arw_get_gbl_att_char(handle, 'GRIDTYPE', grid_type, istatus)
      CALL arw_get_gbl_att_char(handle, 'MMINLU', mminlu, istatus)
      
      !! Make sure we are working with the unstaggered values here
      CALL arw_get_gbl_att_int_sca(handle, 'WEST-EAST_GRID_DIMENSION', west_east_dim, 1, outcount, istatus)
           west_east_dim = west_east_dim - 1
      CALL arw_get_gbl_att_int_sca(handle, 'SOUTH-NORTH_GRID_DIMENSION', south_north_dim, 1, outcount, istatus)
           south_north_dim = south_north_dim - 1
      CALL arw_get_gbl_att_int_sca(handle, 'BOTTOM-TOP_GRID_DIMENSION', bottom_top_dim, 1, outcount, istatus)
!!!!
!!!! fix to allow the use of ncrcat to reduce vertical levels number in wrfout input files
!!!!
include "../change_bottom_top_dim"
!!!!
!!!!
           IF ( iprogram  .le.  1 ) bottom_top_dim = 24      !!! Just to make room for the 3D datasets
           IF ( iprogram .ge. 6 ) bottom_top_dim = bottom_top_dim - 1



      CALL arw_get_gbl_att_int_sca(handle, 'DYN_OPT', dyn_opt, 1, outcount, istatus)
      CALL arw_get_gbl_att_int_sca(handle, 'MAP_PROJ', map_proj, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'DX', dx, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'DY', dy, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'CEN_LAT', cen_lat, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'CEN_LON', cen_lon, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'TRUELAT1', truelat1, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'TRUELAT2', truelat2, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'MOAD_CEN_LAT', moad_cen_lat, 1, outcount, istatus)
      CALL arw_get_gbl_att_real_sca(handle, 'STAND_LON', stand_lon, 1, outcount, istatus)
      !!CALL arw_get_gbl_att_real_arr(handle, 'corner_lats', corner_lats, 16, outcount, istatus)
      !!CALL arw_get_gbl_att_real_arr(handle, 'corner_lons', corner_lons, 16, outcount, istatus)

      !!! Just needed for meta data in the .ctl file
      !CALL arw_get_gbl_att_int_sca(handle, 'DYN_OPT', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'DIFF_OPT', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'KM_OPT', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'DAMP_OPT', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_real_sca(handle, 'KHDIF', dum_r, 1, outcount, istatus)
      !CALL arw_get_gbl_att_real_sca(handle, 'KVDIF', dum_r, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'MP_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'RA_LW_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'RA_SW_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'SF_SFCLAY_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'SF_SURFACE_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'BL_PBL_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'CU_PHYSICS', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'GRID_ID', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'PARENT_ID', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'I_PARENT_START', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'J_PARENT_START', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'PARENT_GRID_RATIO', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_real_sca(handle, 'DT', dum_r, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'ISWATER', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'ISICE', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'ISURBAN', dum_i, 1, outcount, istatus)
      !CALL arw_get_gbl_att_int_sca(handle, 'ISOILWATER', dum_i, 1, outcount, istatus)


   END SUBROUTINE read_global_attrs
 
 
   SUBROUTINE input_close()
 
      implicit none
  
      ! Local variables
      integer :: istatus
  
      istatus = 0
#ifdef IO_BINARY
      if (io_form_input == BINARY) then
         CALL ext_int_ioclose(handle, istatus)
         CALL ext_int_ioexit(istatus)
      end if
#endif
#ifdef IO_NETCDF
      if (io_form_input == NETCDF) then
         CALL ext_ncd_ioclose(handle, istatus)
         CALL ext_ncd_ioexit(istatus)
      end if
#endif
#ifdef IO_GRIB1
      if (io_form_input == GRIB1) then
         CALL ext_gr1_ioclose(handle, istatus)
         CALL ext_gr1_ioexit(istatus)
      end if
#endif
 
      CALL q_destroy(unit_desc)
 
   END SUBROUTINE input_close
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------

   SUBROUTINE arw_ioinit (istatus)

      implicit none

      ! Arguments
      integer             :: istatus

#ifdef IO_BINARY
         if (io_form_input == BINARY) CALL ext_int_ioinit('sysdep info', istatus)
#endif
#ifdef IO_NETCDF
         if (io_form_input == NETCDF) CALL ext_ncd_ioinit('sysdep info', istatus)
#endif
#ifdef IO_GRIB1
         if (io_form_input == GRIB1) CALL ext_gr1_ioinit('sysdep info', istatus)
#endif
         CALL mprintf((istatus /= 0),ERROR,'Error in ext_pkg_ioinit')

   END SUBROUTINE arw_ioinit

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_open_for_read (input_fname, handle, istatus)

      implicit none

      ! Arguments
      integer             :: handle, istatus
      character (len=128) :: input_fname

#ifdef IO_BINARY
         if (io_form_input == BINARY) &
            CALL ext_int_open_for_read(trim(input_fname), 1, 1, 'sysdep info', handle, istatus)
#endif
#ifdef IO_NETCDF
         if (io_form_input == NETCDF) &
            CALL ext_ncd_open_for_read(trim(input_fname), 1, 1, 'sysdep info', handle, istatus)
#endif
#ifdef IO_GRIB1
         if (io_form_input == GRIB1) &
            CALL ext_gr1_open_for_read(trim(input_fname), 1, 1, 'sysdep info', handle, istatus)
#endif
         CALL mprintf((istatus /= 0),ERROR,'Error in ext_pkg_open_for_read')

   END SUBROUTINE arw_open_for_read

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_next_time (handle, datestr, istatus)

      implicit none

      ! Arguments
      integer             :: handle, istatus
      character (len=*)   :: datestr


#ifdef IO_BINARY
        if (io_form_input == BINARY) CALL ext_int_get_next_time(handle, datestr, istatus)
#endif
#ifdef IO_NETCDF
        if (io_form_input == NETCDF) CALL ext_ncd_get_next_time(handle, datestr, istatus)
#endif
#ifdef IO_GRIB1
        if (io_form_input == GRIB1)  CALL ext_gr1_get_next_time(handle, datestr, istatus)
#endif
        !!CALL mprintf((istatus /= 0),ERROR,'Error while reading next time .')

   END SUBROUTINE arw_get_next_time

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_gbl_att_char (handle, att_string, att, istatus)

      implicit none

      ! Arguments
      integer             :: handle, istatus
      character*(*)       :: att_string
      character (len=*)   :: att


#ifdef IO_BINARY
        if (io_form_input == BINARY) CALL ext_int_get_dom_ti_char(handle, att_string, att, istatus)
#endif
#ifdef IO_NETCDF
        if (io_form_input == NETCDF) CALL ext_ncd_get_dom_ti_char(handle, att_string, att, istatus)
#endif
#ifdef IO_GRIB1
        if (io_form_input == GRIB1)  CALL ext_gr1_get_dom_ti_char(handle, att_string, att, istatus)
#endif
        !!CALL mprintf((istatus /= 0),ERROR,'Error while reading domain global charachter attribute.')
        IF ( istatus == 0 ) THEN
          iatts = iatts + 1
          WRITE(catts(iatts),'("@ global String comment ",A," = ",A)') trim(att_string), trim(att)
        END IF 

   END SUBROUTINE arw_get_gbl_att_char

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_gbl_att_int_sca (handle, att_string, att, dim, outcount, istatus)

      implicit none

      ! Arguments
      integer             :: handle, dim, outcount, istatus
      character*(*)       :: att_string
      integer             :: att


#ifdef IO_BINARY
        if (io_form_input == BINARY) CALL ext_int_get_dom_ti_integer(handle, att_string, att, dim, outcount, istatus)
#endif
#ifdef IO_NETCDF
        if (io_form_input == NETCDF) CALL ext_ncd_get_dom_ti_integer(handle, att_string, att, dim, outcount, istatus)
#endif
#ifdef IO_GRIB1
        if (io_form_input == GRIB1)  CALL ext_gr1_get_dom_ti_integer(handle, att_string, att, dim, outcount, istatus)
#endif
        !!CALL mprintf((istatus /= 0),ERROR,'Error while reading domain global integer attribute.')
        IF ( istatus == 0 ) THEN
          iatts = iatts + 1
          WRITE(catts(iatts),'("@ global String comment ",A," = ",i5)') trim(att_string), att
        END IF

   END SUBROUTINE arw_get_gbl_att_int_sca

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_gbl_att_real_sca (handle, att_string, att, dim, outcount, istatus)

      implicit none

      ! Arguments
      integer             :: handle, dim, outcount, istatus
      character*(*)       :: att_string
      real                :: att


#ifdef IO_BINARY
        if (io_form_input == BINARY) CALL ext_int_get_dom_ti_real(handle, att_string, att, dim, outcount, istatus)
#endif
#ifdef IO_NETCDF
        if (io_form_input == NETCDF) CALL ext_ncd_get_dom_ti_real(handle, att_string, att, dim, outcount, istatus)
#endif
#ifdef IO_GRIB1
        if (io_form_input == GRIB1)  CALL ext_gr1_get_dom_ti_real(handle, att_string, att, dim, outcount, istatus)
#endif
        !!CALL mprintf((istatus /= 0),ERROR,'Error while reading domain global real attribute.')
        IF ( istatus == 0 ) THEN
          iatts = iatts + 1
          WRITE(catts(iatts),'("@ global String comment ",A," = ",f12.2)') trim(att_string), att
        END IF

   END SUBROUTINE arw_get_gbl_att_real_sca

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_gbl_att_real_arr (handle, att_string, att, dim, outcount, istatus)

      implicit none

      ! Arguments
      integer             :: handle, dim, outcount, istatus
      character*(*)       :: att_string
      real, dimension(*)  :: att


#ifdef IO_BINARY
        if (io_form_input == BINARY) CALL ext_int_get_dom_ti_real(handle, att_string, att, dim, outcount, istatus)
#endif
#ifdef IO_NETCDF
        if (io_form_input == NETCDF) CALL ext_ncd_get_dom_ti_real(handle, att_string, att, dim, outcount, istatus)
#endif
#ifdef IO_GRIB1
        if (io_form_input == GRIB1)  CALL ext_gr1_get_dom_ti_real(handle, att_string, att, dim, outcount, istatus)
#endif
        CALL mprintf((istatus /= 0),ERROR,'Error while reading domain global real attribute.')

   END SUBROUTINE arw_get_gbl_att_real_arr

!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_next_var (handle, cname, istatus)

      implicit none

      ! Arguments
      integer             :: handle, istatus
      character*(*)       :: cname

#ifdef IO_BINARY
         if (io_form_input == BINARY) CALL ext_int_get_next_var(handle, cname, istatus) 
#endif
#ifdef IO_NETCDF
         if (io_form_input == NETCDF) CALL ext_ncd_get_next_var(handle, cname, istatus) 
#endif
#ifdef IO_GRIB1
         if (io_form_input == GRIB1) CALL ext_gr1_get_next_var(handle, cname, istatus) 
#endif

   END SUBROUTINE arw_get_next_var
 
!------------------------------------------------------------------------------------------

   SUBROUTINE arw_get_var_info (handle, cname, ndim, memorder, stagger, cdesc, cunits, domain_start, domain_end, wrftype, istatus)

      implicit none

      ! Arguments
      integer               :: handle, istatus
      integer               :: ndim, wrftype
      integer, dimension(3) :: domain_start, domain_end
      character*(*)         :: cname, memorder, stagger, cdesc, cunits


      cunits  = ' '
      cdesc   = ' '


#ifdef IO_BINARY
         if (io_form_input == BINARY) &
            CALL ext_int_get_var_info(handle, cname, ndim, memorder, stagger, domain_start, domain_end, wrftype, istatus)
#endif
#ifdef IO_NETCDF
         if (io_form_input == NETCDF) &
            CALL ext_ncd_get_var_info(handle, cname, ndim, memorder, stagger, domain_start, domain_end, wrftype, istatus)
#endif
#ifdef IO_GRIB1
      IF (io_form_input == GRIB1) THEN
 10     read (13,'(i3,5x,A3,4x,A1,5x,A13,A48,A15)',END=999) wrftype, memorder, stagger, cname, cdesc, cunits
        ndim =  LEN_trim(memorder) 
        IF (iprogram .le. 1 .AND. ndim == 3 .AND. INDEX(memorder,'m') == 0) GOTO 10
        IF (iprogram .le. 1 .AND. ndim == 1) GOTO 10
        IF (iprogram == 8 .AND. INDEX(memorder,'g') /= 0) GOTO 10
        IF      ( LEN_trim(memorder) == 3 ) THEN
                domain_end(1) = west_east_dim
                domain_end(2) = south_north_dim
                domain_end(3) = bottom_top_dim
                IF (stagger(1:1) == "X") domain_end(1) = domain_end(1) + 1
                IF (stagger(1:1) == "Y") domain_end(2) = domain_end(2) + 1
                IF (iprogram .ge. 6 .AND. stagger(1:1) == "Z") domain_end(3) = domain_end(3) + 1
                IF ( INDEX(memorder,'m') /= 0 ) domain_end(3) = 12
                IF ( INDEX(memorder,'u') /= 0 ) domain_end(3) = 24
                memorder = "XYZ"
        ELSE IF ( LEN_trim(memorder) == 2 ) THEN
                domain_end(1) = west_east_dim
                domain_end(2) = south_north_dim
                IF (stagger(1:1) == "X") domain_end(1) = domain_end(1) + 1
                IF (stagger(1:1) == "Y") domain_end(2) = domain_end(2) + 1
                memorder = "XY"
        ELSE IF ( LEN_trim(memorder) == 1 ) THEN
                domain_end(1) = bottom_top_dim
                IF (iprogram .ge. 6 .AND. stagger(1:1) == "Z") domain_end(1) = domain_end(1) + 1
                memorder = "Z"
        END IF
      END IF
#endif
     
         CALL mprintf((istatus /= 0),ERROR,'In read_next_field(), problems with ext_pkg_get_var_info()')
        RETURN
  999   istatus = -1     !!! Reached end of file

   END SUBROUTINE arw_get_var_info
 
!------------------------------------------------------------------------------------------

   SUBROUTINE arw_read_field (handle, valid_date, cname, real_domain, wrftype, &
                             memorder, stagger, &
                             dimnames, domain_start, domain_end, istatus)

      implicit none

      ! Arguments
      integer                            :: handle, istatus
      integer                            :: ndim, wrftype
      integer, dimension(3)              :: domain_start, domain_end
      character*(*)                      :: cname, memorder, stagger, valid_date
      character (len=128), dimension(3)  :: dimnames
      real, pointer, dimension(:,:,:)    :: real_domain
      integer, pointer, dimension(:,:,:) :: int_domain
  
#include "wrf_io_flags.h"
#include "wrf_status_codes.h"
 

!!! caca 
!print *, 'arw_read_field ', handle, valid_date, cname, wrftype, &
!                             memorder, stagger, &
!                             dimnames, domain_start, domain_end, istatus
!!! caca

         if (wrftype == WRF_REAL) then
#ifdef IO_BINARY
            if (io_form_input == BINARY) then
               CALL ext_int_read_field(handle, valid_date, cname, real_domain, wrftype, &
                             1, 1, 0, memorder, stagger, &
                             dimnames, domain_start, domain_end, domain_start, domain_end, &
                             domain_start, domain_end, istatus)
            end if
#endif
#ifdef IO_NETCDF
            if (io_form_input == NETCDF) then
               CALL ext_ncd_read_field(handle, valid_date, cname, real_domain, wrftype, &
                             1, 1, 0, memorder, stagger, &
                             dimnames, domain_start, domain_end, domain_start, domain_end, &
                             domain_start, domain_end, istatus)
            end if
#endif
#ifdef IO_GRIB1
            if (io_form_input == GRIB1) then
               CALL ext_gr1_read_field(handle, valid_date, cname, real_domain, wrftype, &
                             1, 1, 0, memorder, stagger, &
                             dimnames, domain_start, domain_end, domain_start, domain_end, &
                             domain_start, domain_end, istatus)
            end if
#endif
         elseif (wrftype == WRF_INTEGER) then
         allocate(int_domain(domain_start(1):domain_end(1), domain_start(2):domain_end(2), domain_start(3):domain_end(3)))
#ifdef IO_BINARY
            if (io_form_input == BINARY) then
               CALL ext_int_read_field(handle, valid_date, cname, int_domain, wrftype, &
                             1, 1, 0, memorder, stagger, &
                             dimnames, domain_start, domain_end, domain_start, domain_end, &
                             domain_start, domain_end, istatus)
            end if
#endif
#ifdef IO_NETCDF
            if (io_form_input == NETCDF) then
               CALL ext_ncd_read_field(handle, valid_date, cname, int_domain, wrftype, &
                             1, 1, 0, memorder, stagger, &
                             dimnames, domain_start, domain_end, domain_start, domain_end, &
                             domain_start, domain_end, istatus)
            end if
#endif
#ifdef IO_GRIB1
            if (io_form_input == GRIB1) then
               CALL ext_gr1_read_field(handle, valid_date, cname, int_domain, wrftype, &
                             1, 1, 0, memorder, stagger, &
                             dimnames, domain_start, domain_end, domain_start, domain_end, &
                             domain_start, domain_end, istatus)
            end if
#endif
            real_domain = real(int_domain)
            deallocate(int_domain)
         end if 
#ifdef IO_GRIB1
            if (io_form_input == GRIB1 .AND. istatus == -5 ) RETURN
#endif
         CALL mprintf((istatus /= 0),ERROR,'In read_field(), got error code %i.', i1=istatus)


   END SUBROUTINE arw_read_field
 
!------------------------------------------------------------------------------------------

END MODULE input_module
