!WRF:MEDIATION:IO
  SUBROUTINE wrf_ext_write_field_arr(DataHandle,DateStr,Var       &
                                ,Field                            &
                                ,idx4, idx5, idx6, idx7           &
                                ,nx4 , nx5 , nx6                  &
                                ,TypeSizeInBytes                  &
                                ,FieldType,grid                   &
                                ,DomainDesc                       &
                                ,bdy_mask                         &
                                ,dryrun                           &
                                ,MemoryOrder                      &
                                ,Stagger                          &
                                ,Dimname1, Dimname2, Dimname3     &
                                ,Desc, Units                      &
                                ,debug_message                                &
                                ,ds1, de1, ds2, de2, ds3, de3                 &
                                ,ms1, me1, ms2, me2, ms3, me3                 &
                                ,ps1, pe1, ps2, pe2, ps3, pe3, Status          )
    USE module_io
    USE module_wrf_error
    USE module_state_description
    USE module_timing
    USE module_domain

    IMPLICIT NONE

    INTEGER, INTENT(IN)       :: idx4, idx5, idx6, idx7
    INTEGER, INTENT(IN)       :: nx4 , nx5 , nx6
    INTEGER, INTENT(IN)       :: TypeSizeInBytes
    INTEGER               ,INTENT(IN   )         :: DataHandle
    CHARACTER*(*)         ,INTENT(IN   )         :: DateStr
    CHARACTER*(*)         ,INTENT(IN   )         :: Var
    INTEGER               ,INTENT(IN   )         :: Field(*)
    INTEGER               ,INTENT(IN   )         :: FieldType
    TYPE(domain)                                 :: grid
    INTEGER               ,INTENT(IN   )         :: DomainDesc
    LOGICAL               ,INTENT(IN   )         :: dryrun
    CHARACTER*(*)         ,INTENT(IN   )         :: MemoryOrder
    LOGICAL, DIMENSION(4) ,INTENT(IN   )         :: bdy_mask
    CHARACTER*(*)         ,INTENT(IN   )         :: Stagger
    CHARACTER*(*)         ,INTENT(IN   )         :: Dimname1, Dimname2, Dimname3
    CHARACTER*(*)         ,INTENT(IN   )         :: Desc, Units
    CHARACTER*(*)         ,INTENT(IN   )         :: debug_message

    INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
                                     ms1, me1, ms2, me2, ms3, me3, &
                                     ps1, pe1, ps2, pe2, ps3, pe3
    INTEGER ,       INTENT(INOUT) :: Status
! Local
    INTEGER  tsfac  ! Type size factor
    CHARACTER*256 mess

    tsfac = TypeSizeInBytes / IWORDSIZE

    IF ( tsfac .LE. 0 ) THEN
      CALL wrf_message('wrf_ext_write_field_arr')
      WRITE(mess,*)'Internal error: email this message to wrfhelp@ucar.edu ',TypeSizeInBytes,IWORDSIZE
      CALL wrf_error_fatal(mess)
    ENDIF

    CALL wrf_ext_write_field(    DataHandle,DateStr,Var           &
                                ,Field(1                                                            &
                                      +tsfac*(0                                                     &
                                      +(idx4-1)*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)                 &
                                      +(idx5-1)*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)             &
                                      +(idx6-1)*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)         &
                                      +(idx7-1)*nx6*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1)))   &
                                ,FieldType,grid                   &
                                ,DomainDesc                       &
                                ,bdy_mask                         &
                                ,dryrun                           &
                                ,MemoryOrder                      &
                                ,Stagger                          &
                                ,Dimname1, Dimname2, Dimname3     &
                                ,Desc, Units                      &
                                ,debug_message                                &
                                ,ds1, de1, ds2, de2, ds3, de3                 &
                                ,ms1, me1, ms2, me2, ms3, me3                 &
                                ,ps1, pe1, ps2, pe2, ps3, pe3, Status          )
    
  END SUBROUTINE wrf_ext_write_field_arr


  SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,grid, &
                                 DomainDesc,                      &
                                 bdy_mask   ,                     &
                                 dryrun        ,                  &
                                 MemoryOrder,                     &
                                 Stagger,                         &
                                 Dimname1, Dimname2, Dimname3 ,   &
                                 Desc, Units,                     &
                                 debug_message ,                              &
                                 ds1, de1, ds2, de2, ds3, de3,                &
                                 ms1, me1, ms2, me2, ms3, me3,                &
                                 ps1, pe1, ps2, pe2, ps3, pe3, Status          )
    USE module_io
    USE module_wrf_error
    USE module_state_description
    USE module_timing
    USE module_domain

    IMPLICIT NONE

    INTEGER               ,INTENT(IN   )         :: DataHandle
    CHARACTER*(*)         ,INTENT(IN   )         :: DateStr
    CHARACTER*(*)         ,INTENT(IN   )         :: Var
    INTEGER               ,INTENT(IN   )         :: Field(*)
    INTEGER               ,INTENT(IN   )         :: FieldType
    TYPE(domain)                                 :: grid
    INTEGER               ,INTENT(IN   )         :: DomainDesc
    LOGICAL               ,INTENT(IN   )         :: dryrun
    CHARACTER*(*)         ,INTENT(IN   )         :: MemoryOrder
    LOGICAL, DIMENSION(4) ,INTENT(IN   )         :: bdy_mask
    CHARACTER*(*)         ,INTENT(IN   )         :: Stagger
    CHARACTER*(*)         ,INTENT(IN   )         :: Dimname1, Dimname2, Dimname3
    CHARACTER*(*)         ,INTENT(IN   )         :: Desc, Units
    CHARACTER*(*)         ,INTENT(IN   )         :: debug_message

    INTEGER ,       INTENT(IN   ) :: ds1, de1, ds2, de2, ds3, de3, &
                                     ms1, me1, ms2, me2, ms3, me3, &
                                     ps1, pe1, ps2, pe2, ps3, pe3

! Local
    INTEGER , DIMENSION(3) :: domain_start , domain_end
    INTEGER , DIMENSION(3) :: memory_start , memory_end
    INTEGER , DIMENSION(3) :: patch_start , patch_end
    CHARACTER*80 , DIMENSION(3) :: dimnames

    integer                       ,intent(inout)   :: Status
    LOGICAL for_out, horiz_stagger
    INTEGER io_form
    LOGICAL, EXTERNAL :: has_char
    INTEGER, EXTERNAL :: use_package
    INTEGER Hndl

    IF ( wrf_at_debug_level( 500 ) ) THEN
      call start_timing
    ENDIF
    domain_start(1) = ds1 ; domain_end(1) = de1 ;
    patch_start(1)  = ps1 ; patch_end(1)  = pe1 ;
    memory_start(1) = ms1 ; memory_end(1) = me1 ;
    domain_start(2) = ds2 ; domain_end(2) = de2 ;
    patch_start(2)  = ps2 ; patch_end(2)  = pe2 ;
    memory_start(2) = ms2 ; memory_end(2) = me2 ;
    domain_start(3) = ds3 ; domain_end(3) = de3 ;
    patch_start(3)  = ps3 ; patch_end(3)  = pe3 ;
    memory_start(3) = ms3 ; memory_end(3) = me3 ;

    dimnames(1) = Dimname1
    dimnames(2) = Dimname2
    dimnames(3) = Dimname3

    CALL debug_io_wrf ( debug_message,DateStr,                          &
                        domain_start,domain_end,patch_start,patch_end,  &
                        memory_start,memory_end                          )
#if 0
    Status = 1
    if ( de1 - ds1 < 0 ) return
    if ( de2 - ds2 < 0 ) return
    if ( de3 - ds3 < 0 ) return
    if ( pe1 - ps1 < 0 ) return
    if ( pe2 - ps2 < 0 ) return
    if ( pe3 - ps3 < 0 ) return
    if ( me1 - ms1 < 0 ) return
    if ( me2 - ms2 < 0 ) return
    if ( me3 - ms3 < 0 ) return
#endif
    Status = 0

    CALL wrf_write_field (   &
                       DataHandle                 &  ! DataHandle
                      ,DateStr                    &  ! DateStr
                      ,Var                        &  ! Data Name
                      ,Field                      &  ! Field
                      ,FieldType                  &  ! FieldType
                      ,grid                       &  ! grid
                      ,DomainDesc                 &  ! DomainDesc
                      ,bdy_mask                   &  ! bdy_mask
                      ,MemoryOrder                &  ! MemoryOrder
                      ,Stagger                    &  ! JMMODS 010620
                      ,dimnames                   &  ! JMMODS 001109
                      ,domain_start               &  ! DomainStart
                      ,domain_end                 &  ! DomainEnd
                      ,memory_start               &  ! MemoryStart
                      ,memory_end                 &  ! MemoryEnd
                      ,patch_start                &  ! PatchStart
                      ,patch_end                  &  ! PatchEnd
                      ,Status )

    CALL get_handle ( Hndl, io_form , for_out, DataHandle )

    IF ( ( dryrun .AND. ( use_package(io_form) .EQ. IO_NETCDF .OR. &
                          use_package(io_form) .EQ. IO_PIO    .OR. &
                          use_package(io_form) .EQ. IO_PNETCDF ) ) .OR. &
                        ( use_package(io_form) .EQ. IO_PHDF5  )   ) THEN

      CALL wrf_put_var_ti_char( &
                       DataHandle                 &  ! DataHandle
                      ,"description"              &  ! Element
                      ,Var                        &  ! Data Name
                      ,Desc                       &  ! Data
                      ,Status )
      CALL wrf_put_var_ti_char( &
                       DataHandle                 &  ! DataHandle
                      ,"units"                    &  ! Element
                      ,Var                        &  ! Data Name
                      ,Units                      &  ! Data
                      ,Status )
      CALL wrf_put_var_ti_char( &
                       DataHandle                 &  ! DataHandle
                      ,"stagger"                  &  ! Element
                      ,Var                        &  ! Data Name
                      ,Stagger                    &  ! Data
                      ,Status )
#if (EM_CORE == 1)
! TBH:  Added "coordinates" metadata for GIS folks in RAL.  It is a step 
! TBH:  towards CF.  This change was requested by Jennifer Boehnert based 
! TBH:  upon a suggestion from Nawajish Noman.  
! TBH:  TODO:  This code depends upon longitude and latitude arrays being 
! TBH:         named "XLONG", "XLAT", "XLONG_U", "XLAT_U", "XLONG_V", and 
! TBH:         "XLAT_V" for EM_CORE.  We need a more general way to handle 
! TBH:         this, possibly via the Registry.  
! TBH:  TODO:  Use dimnames(*) == south_north || west_east instead of 
! TBH:         MemoryOrder and Stagger?  It would also work for both ARW 
! TBH:         and NMM and be easier to handle via Registry...  

      IF ( ( TRIM(MemoryOrder) == 'XY' ) .AND. &
         ( ( TRIM(Var) == 'XLONG'   ) .OR. &
           ( TRIM(Var) == 'XLAT'    ) .OR. &
           ( TRIM(Var) == 'XLONG_U' ) .OR. &
           ( TRIM(Var) == 'XLAT_U'  ) .OR. &
           ( TRIM(Var) == 'XLONG_V' ) .OR. &
           ( TRIM(Var) == 'XLAT_V'  ) ) ) THEN
        horiz_stagger = .FALSE.
        IF ( LEN_TRIM(Stagger) == 1 ) THEN
          IF ( has_char( Stagger, 'x' ) ) THEN
            horiz_stagger = .TRUE.
            CALL wrf_put_var_ti_char( &
                             DataHandle                 &  ! DataHandle
                            ,"coordinates"              &  ! Element
                            ,Var                        &  ! Data Name
                            ,"XLONG_U XLAT_U"           &  ! Data
                            ,Status )
          ELSE IF ( has_char( Stagger, 'y' ) ) THEN
            horiz_stagger = .TRUE.
            CALL wrf_put_var_ti_char( &
                             DataHandle                 &  ! DataHandle
                            ,"coordinates"              &  ! Element
                            ,Var                        &  ! Data Name
                            ,"XLONG_V XLAT_V"           &  ! Data
                            ,Status )
          ENDIF
        ENDIF
        IF ( .NOT. horiz_stagger ) THEN
          CALL wrf_put_var_ti_char( &
                           DataHandle                 &  ! DataHandle
                          ,"coordinates"              &  ! Element
                          ,Var                        &  ! Data Name
                          ,"XLONG XLAT"               &  ! Data
                          ,Status )
        ENDIF
      ELSE IF ( ( TRIM(MemoryOrder) == 'XY'  ) .OR. &
                ( TRIM(MemoryOrder) == 'XZY' ) .OR. &
                ( TRIM(MemoryOrder) == 'XYZ' ) ) THEN
        horiz_stagger = .FALSE.
        IF ( LEN_TRIM(Stagger) == 1 ) THEN
          IF ( has_char( Stagger, 'x' ) ) THEN
            horiz_stagger = .TRUE.
            CALL wrf_put_var_ti_char( &
                             DataHandle                 &  ! DataHandle
                            ,"coordinates"              &  ! Element
                            ,Var                        &  ! Data Name
                            ,"XLONG_U XLAT_U XTIME"     &  ! Data
                            ,Status )
          ELSE IF ( has_char( Stagger, 'y' ) ) THEN
            horiz_stagger = .TRUE.
            CALL wrf_put_var_ti_char( &
                             DataHandle                 &  ! DataHandle
                            ,"coordinates"              &  ! Element
                            ,Var                        &  ! Data Name
                            ,"XLONG_V XLAT_V XTIME"     &  ! Data
                            ,Status )
          ENDIF
        ENDIF
        IF ( .NOT. horiz_stagger ) THEN
          CALL wrf_put_var_ti_char( &
                           DataHandle                 &  ! DataHandle
                          ,"coordinates"              &  ! Element
                          ,Var                        &  ! Data Name
                          ,"XLONG XLAT XTIME"         &  ! Data
                          ,Status )
        ENDIF
      ENDIF
#endif
    ENDIF

    IF ( wrf_at_debug_level(300) ) THEN
      WRITE(wrf_err_message,*) debug_message,' Status = ',Status
      CALL wrf_message ( TRIM(wrf_err_message) )
    ENDIF

    IF ( wrf_at_debug_level( 500 ) ) THEN
      CALL end_timing('wrf_ext_write_field')
    ENDIF

  END SUBROUTINE wrf_ext_write_field
