!-----------------------------------------------------------------------
!
      MODULE MODULE_WRITE_ROUTINES
!
!-----------------------------------------------------------------------
!***  This module contains routines needed by the Run step of the
!***  Write gridded component in which history output data from
!***  the forecast tasks are assembled and written to history files
!***  by the write tasks.
!-----------------------------------------------------------------------
!***
!***  HISTORY   
!***
!       06 Sep 2007:  T. Black - Created module.
!                                Moved the FIRST block from the old
!                                Write component here for clarity.
!       15 Aug 2008:  J. Wang  - Revised for NEMS-IO
!       20 Aug 2008:  J. Wang  - Output start date first instead of
!                                forecast date.
!       16 Sep 2008:  J. Wang  - WRITE_NEMSIO_RUNHISTORY_OPEN only
!                                opens file and writes metadata.
!       30 Sep 2008:  E. Colon - Generalize counts for nemsio
!       14 Oct 2008:  R. Vasic - Added restart capability
!       05 Jan 2009:  J. Wang  - Added 10-m wind factor to NMMB
!                                runhistory and restart files.
!       06 Jan 2009:  T. Black - Replace Max # of words recv'd by
!                                Write tasks with actual # of words.
!       03 Sep 2009:  T. Black - Merged with NMM-B nesting code.
!       24 Mar 2010:  T. Black - Revised for NEMS restructing.
!       07 May 2010:  T. Black - Change output frequency to minutes.
!       16 Dec 2010:  J. Wang  - Change to nemsio library
!          Feb 2011:  W. Yang  - Updated to use both the ESMF 4.0.0rp2 library,
!                                ESMF 5 library and the the ESMF 3.1.0rp2 library.
!          May 2011:  J. Wang  - add run post on quilt option
!       27 SEP 2011:  W. Yang  - Modified for using the ESMF 5.2.0r library.
!       18 JUL 2018:  O. Jorba - NETCDF output option
!
!---------------------------------------------------------------------------------
!
      USE MPI
      USE ESMF
      USE NETCDF
!
      USE MODULE_WRITE_INTERNAL_STATE,ONLY: WRITE_INTERNAL_STATE        &
                                           ,WRITE_WRAP                  &
                                           ,MAX_DATA_I1D                &
                                           ,MAX_DATA_I2D                &
                                           ,MAX_DATA_R1D                &
                                           ,MAX_DATA_R2D                &
                                           ,MAX_DATA_LOG                
!
      USE MODULE_DOMAIN_INTERNAL_STATE,ONLY: DOMAIN_INTERNAL_STATE
!
      USE MODULE_DM_PARALLEL,ONLY : PARA_RANGE                          &
                                   ,MPI_COMM_COMP
!
      USE MODULE_CONTROL,ONLY : TIMEF
!
      USE MODULE_KINDS
!
      USE MODULE_ERROR_MSG,ONLY: ERR_MSG,MESSAGE_CHECK
!
      USE NEMSIO_MODULE
!
      USE MODULE_CONSTANTS,ONLY : A,PI,G
!
!-----------------------------------------------------------------------
!
      IMPLICIT NONE
!
!-----------------------------------------------------------------------

      PRIVATE
!
      PUBLIC :: SEND_UPDATED_ATTRIBUTES                                 &
               ,WRITE_ASYNC                                             &
               ,WRITE_INIT                                              &
               ,WRITE_NETCDF_RUNHISTORY_OPEN                            &
               ,WRITE_NEMSIO_RUNHISTORY_OPEN                            &
               ,WRITE_NEMSIO_RUNRESTART_OPEN                            &
               ,WRITE_NEMSIOCTL                                         &
               ,WRITE_RUNHISTORY_OPEN                                   &
               ,WRITE_RUNRESTART_OPEN                                   &
               ,OPEN_HST_FILE                                           &
               ,OPEN_RST_FILE
!
!-----------------------------------------------------------------------
!
      LOGICAL,PUBLIC,SAVE :: TIME_FOR_HISTORY = .FALSE.                 &
                            ,TIME_FOR_RESTART = .FALSE.
!
      INTEGER,PARAMETER,PUBLIC :: NETCDF_LABEL_MAX_LENGTH = 100           !<-- Maxiumum size for a NetCDF label
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE PRELIM_INFO_FOR_OUTPUT(OUTPUT_FLAG                     &
                                       ,NUM_PES_FCST                    &
                                       ,NUM_WRITE_GROUPS                &
                                       ,WRITE_COMPS                     &
                                       ,IMP_STATE_WRITE )
! 
!-----------------------------------------------------------------------
!***  This routine will perform certain computations and operations
!***  that only need to be done once for each Write group.  Data that
!***  does not change with forecast time is unloaded from the Write
!***  components' import state.  The data that is unloaded consists
!***  of everything except the 2D/3D gridded forecast arrays (whose
!***  contents do change with time).  Also basic information is 
!***  provided to forecast and write tasks that will be necessary in
!***  the quilting of local 2-D gridded history data into full domain
!***  arrays.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      CHARACTER(len=7),INTENT(IN) :: OUTPUT_FLAG
!
      INTEGER(kind=KINT),INTENT(INOUT) :: NUM_PES_FCST                  &  !<-- # of forecast tasks
                                         ,NUM_WRITE_GROUPS                 !<-- # of write groups
!
      TYPE(ESMF_GridComp),DIMENSION(NUM_WRITE_GROUPS),INTENT(IN) ::     &
                                                          WRITE_COMPS      !<-- The array of Write components
!
      TYPE(ESMF_State),INTENT(INOUT) :: IMP_STATE_WRITE                    !<-- The import state of the Write components
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KDIN) :: NUM_WORDS_TOT
!
      INTEGER(kind=KINT) :: COMM_MY_DOMAIN                              &
                           ,MYPE_DOMAIN
!
      INTEGER(kind=KINT),SAVE :: ITS,ITE,JTS,JTE                        &
                                ,NCHAR_I1D                              &
                                ,NCHAR_R1D                              &
                                ,NCHAR_LOG
!
      INTEGER(kind=KINT) :: I,IERR,IM,ISTAT,J,JM,L,M1,M2                &
                           ,N,N1,N2,NN,NUM_ATTRIB,NWTPG,NX,NY           &
                           ,RC,RC_WRT
!
      INTEGER(kind=KINT) :: JROW_FIRST,JROW_LAST,JROWS                  &
                           ,LAST_FCST_TASK                              &
                           ,LOCAL_ID                                    &
                           ,N_END                                       &
                           ,N_STA
!
      INTEGER(kind=KINT) :: JEND_WRITE,JSTA_WRITE
!
      INTEGER(kind=KINT) :: KOUNT_I1D_X                                 &
                           ,KOUNT_I2D_X                                 &
                           ,KOUNT_R1D_X                                 &
                           ,KOUNT_R2D_X                                 &
                           ,KOUNT_LOG_X
!
      INTEGER(kind=KINT) :: LENGTH                                      &
                           ,LENGTH_SUM_I1D_X                            &
                           ,LENGTH_SUM_R1D_X                            &
                           ,LENGTH_SUM_LOG_X
!
      INTEGER(kind=KINT) :: MAX_WORDS                                   &
                           ,NPOSN_START,NPOSN_END                       &
                           ,NUM_FIELD_NAMES                             &
                           ,NUM_WORDS
!
      INTEGER(kind=KINT),DIMENSION(NUM_WRITE_GROUPS) :: LEAD_WRITE_TASK &
                                                       ,LAST_WRITE_TASK
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: IHALO,INPES            &
                                                ,JHALO,JNPES            &
                                                ,LOCAL_ISTART           &
                                                ,LOCAL_IEND             &
                                                ,LOCAL_JSTART           &
                                                ,LOCAL_JEND
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: NCHAR_I2D              &
                                                ,NCHAR_R2D              &
                                                ,WORK_ARRAY_I1D
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: WORK_ARRAY_R1D
!
      CHARACTER(len=14) :: BUNDLE_NAME
!
      CHARACTER(ESMF_MAXSTR) :: ATTRIB_NAME
! 
      LOGICAL(kind=KLOG) :: NO_FIELDS
!
      TYPE(WRITE_WRAP) :: WRAP
!
      TYPE(WRITE_INTERNAL_STATE),POINTER :: WRT_INT_STATE
!
      TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
      TYPE(ESMF_Field) :: FIELD_WORK1
!
      LOGICAL(kind=KLOG) :: WORK_LOGICAL
!
      TYPE(ESMF_VM) :: VM_DOMAIN
!
      TYPE(ESMF_FieldBundle) :: OUTPUT_BUNDLE 
!
      TYPE :: TEMP_INT_STATE
        TYPE(WRITE_INTERNAL_STATE),POINTER :: LOC_INT_STATE
      END TYPE
!
      TYPE(TEMP_INT_STATE),DIMENSION(:),ALLOCATABLE :: WRT_INT_STATE_X
!
!----------------------------------------------------
!***  Local pointers to History or Restart variables
!***  in the Write component's internal state.
!----------------------------------------------------
!
      INTEGER(kind=KINT),POINTER :: NUM_WORDS_SEND_I2D                  &
                                   ,NUM_WORDS_SEND_R2D
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: KOUNT_I1D              &
                                                ,KOUNT_I2D              &
                                                ,KOUNT_R1D              &
                                                ,KOUNT_R2D              &
                                                ,KOUNT_LOG
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: LENGTH_DATA_I1D        &
                                                ,LENGTH_DATA_R1D        &
                                                ,LENGTH_DATA_R2D
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: LENGTH_SUM_I1D         &
                                                ,LENGTH_SUM_R1D         &
                                                ,LENGTH_SUM_R2D         &
                                                ,LENGTH_SUM_LOG
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: NUM_WORDS_RECV_I2D     &
                                                ,NUM_WORDS_RECV_R2D
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: NCOUNT_FIELDS
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: ALL_DATA_I1D           &
                                                ,ALL_DATA_I2D
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: BUFF_INT
!
      INTEGER(kind=KINT),DIMENSION(:,:),POINTER :: OUTPUT_ARRAY_I2D
!
      INTEGER(kind=KINT),DIMENSION(:,:,:),POINTER :: WRITE_SUBSET_I
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: ALL_DATA_R1D              &
                                             ,ALL_DATA_R2D
!
      REAL(kind=KFPT),DIMENSION(:),POINTER :: BUFF_REAL
!
      REAL(kind=KFPT),DIMENSION(:,:),POINTER :: OUTPUT_ARRAY_R2D
!
      REAL(kind=KFPT),DIMENSION(:,:,:),POINTER :: WRITE_SUBSET_R
!
      CHARACTER(ESMF_MAXSTR),DIMENSION(:),POINTER :: FIELD_NAME
!
      CHARACTER(ESMF_MAXSTR*MAX_DATA_I1D),POINTER :: NAMES_I1D_STRING   
      CHARACTER(ESMF_MAXSTR*MAX_DATA_I2D),POINTER :: NAMES_I2D_STRING
      CHARACTER(ESMF_MAXSTR*MAX_DATA_R1D),POINTER :: NAMES_R1D_STRING
      CHARACTER(ESMF_MAXSTR*MAX_DATA_R2D),POINTER :: NAMES_R2D_STRING
      CHARACTER(ESMF_MAXSTR*MAX_DATA_LOG),POINTER :: NAMES_LOG_STRING
!
      LOGICAL,           DIMENSION(:),POINTER :: ALL_DATA_LOG

!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Get this domain's VM (ESMF Virtual Machine) and the domain's
!***  MPI communicator so we can address all the tasks as needed.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="PRELIM_INFO_FOR_HISTORY: Get the Global VM"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!
      CALL ESMF_VMGetCurrent(vm=VM_DOMAIN                               &  !<-- The VM for all tasks on this domain
                            ,rc=RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Extract the Communicator from the Global VM"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_VMGet(vm             =VM_DOMAIN                         &
                     ,mpiCommunicator=COMM_MY_DOMAIN                    &  !<-- The communicator for all tasks on this domain
                     ,localPet       =MYPE_DOMAIN                       &  !<-- Each task's full-domain rank
                     ,rc             =RC )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Let the forecast tasks do all the work they need to do first.
!***  While the number of Write components is equal to WRITE_GROUPS
!***  the contents of the internal state of each of those components
!***  is identical for the forecast tasks.  The forecast tasks begin
!***  by extracting the internal state from the Write component for
!***  write group #1.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  NOTE:  All the forecast tasks are part of ALL write groups
!***         while each write task belongs to only one of the write
!***         groups.  In the work below the forecast tasks will
!***         fill all their relevant variables within the internal
!***         state of the Write component for write group #1 while
!***         providing the write tasks the quantities they need for
!***         the their variables within the internal state of the
!***         Write component associated for their particular write
!***         group.  At the end of this subroutine the forecast
!***         tasks then need to set the same internal state variables
!***         for each of the other Write components with which they
!***         are associated.
!-----------------------------------------------------------------------
!
      LAST_FCST_TASK=NUM_PES_FCST-1                                        !<-- The rank of the final forecast task
!
!-----------------------------------------------------------------------
!
      fcst_tasks_1: IF(MYPE_DOMAIN<=LAST_FCST_TASK)THEN                    !<-- Select only the forecast tasks
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="PRELIM_INFO: Fcst Tasks Get the Write Internal State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_GridCompGetInternalState(WRITE_COMPS(1)               &
                                          ,WRAP                         &
                                          ,RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        WRT_INT_STATE=>wrap%WRITE_INT_STATE                                !<-- Local working pointer to internal state
!
!-----------------------------------------------------------------------
!***  Extract the number of Write tasks in each group.
!-----------------------------------------------------------------------
!
        NWTPG=wrt_int_state%WRITE_TASKS_PER_GROUP
!
      ENDIF fcst_tasks_1
!
!-----------------------------------------------------------------------
!
      CALL MPI_BCAST(NWTPG                                              &  !<-- Broadcast the # of write tasks per group
                    ,1                                                  &  !<-- It is a scalar
                    ,MPI_INTEGER                                        &  !<-- It is an integer
                    ,0                                                  &  !<-- The lead forecast task broadcasts
                    ,COMM_MY_DOMAIN                                     &  !<-- The domain communicator
                    ,IERR)
!
!-----------------------------------------------------------------------
!***  The ranks of key forecast and write tasks. 
!-----------------------------------------------------------------------
!
      LEAD_WRITE_TASK(1)=LAST_FCST_TASK+1                                  !<-- The rank of the lead write task in group 1
      LAST_WRITE_TASK(1)=LAST_FCST_TASK+NWTPG                              !<-- The rank of the last write task in group 1
!
      IF(NUM_WRITE_GROUPS>=2)THEN
        DO N=2,NUM_WRITE_GROUPS
          LEAD_WRITE_TASK(N)=LEAD_WRITE_TASK(N-1)+NWTPG                    !<-- The rank of the lead write task in group N
          LAST_WRITE_TASK(N)=LEAD_WRITE_TASK(N)+NWTPG-1                    !<-- The rank of the final write task in group N
        ENDDO
      ENDIF
!
!-----------------------------------------------------------------------
!***  Now all the tasks in each Write group can extract the
!***  internal state from their respective Write component.
!-----------------------------------------------------------------------
!
      DO N=1,NUM_WRITE_GROUPS
!
        IF(MYPE_DOMAIN>=LEAD_WRITE_TASK(N).AND.                         &
           MYPE_DOMAIN<=LAST_WRITE_TASK(N))THEN
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="PRELIM_INFO: Write Tasks Get the Write Internal State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_GridCompGetInternalState(WRITE_COMPS(N)             &
                                            ,WRAP                       &
                                            ,RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          WRT_INT_STATE=>wrap%WRITE_INT_STATE                              !<-- Local working pointer to internal state
!
        ENDIF
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Now that all forecast and write tasks can see the internal state
!***  of their Write component, point the local working pointers at the
!***  appropriate components within the internal state depending upon
!***  whether we are preparing work for History or Restart output.
!***  In that way the following code can be used for both cases
!***  without a huge number of IF tests.
!-----------------------------------------------------------------------
!
      CALL POINT_LOCAL
!
!-----------------------------------------------------------------------
!
      ALLOCATE(INPES(1))
      ALLOCATE(JNPES(1))
      ALLOCATE(IHALO(1))
      ALLOCATE(JHALO(1))
      ALLOCATE(NCHAR_I2D(1))
      ALLOCATE(NCHAR_R2D(1))
!
!-----------------------------------------------------------------------
!***  Extract the appropriate output Bundle from the Write component's
!***  import state and then from it extract the full domain limits.
!***  These are needed for allocating the working arrays that will
!***  move the 2-D and 3-D Fields from the import to the export state.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
      domain_limits: IF(MYPE_DOMAIN<=LAST_FCST_TASK)THEN                   !<-- This selects only forecast tasks to do extractions
                                                                           !    since only they know what is in the import state.
!-----------------------------------------------------------------------
!
        IF(OUTPUT_FLAG=='History')THEN
          BUNDLE_NAME='History Bundle'
        ELSEIF(OUTPUT_FLAG=='Restart')THEN
          BUNDLE_NAME='Restart Bundle'
        ENDIF
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract the History Bundle from the Write Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_StateGet(state      =IMP_STATE_WRITE                  &  !<-- The Write component's import state
                          ,itemName   =BUNDLE_NAME                      &  !<-- The name of the data Bundle
                          ,fieldbundle=OUTPUT_BUNDLE                    &  !<-- The data Bundle inside the import state
                          ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Allocate the arrays that hold all start and end points in I,J
!***  for all forecast tasks.
!-----------------------------------------------------------------------
!
        ALLOCATE(LOCAL_ISTART(0:LAST_FCST_TASK),stat=RC)
        ALLOCATE(LOCAL_IEND  (0:LAST_FCST_TASK),stat=RC)
        ALLOCATE(LOCAL_JSTART(0:LAST_FCST_TASK),stat=RC)
        ALLOCATE(LOCAL_JEND  (0:LAST_FCST_TASK),stat=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Global Parameters from Output Bundle" 
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
! 
        CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE                &  !<-- The Bundle of output data
                              ,name       ='IM'                         &  !<-- Name of the Attribute to extract
                              ,valueList  =wrt_int_state%IM             &  !<-- Extract this Attribute from History Bundle
                              ,rc         =RC)
!
        CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE                &  !<-- The Bundle of output data
                              ,name       ='JM'                         &  !<-- Name of the Attribute to extract
                              ,valueList  =wrt_int_state%JM             &  !<-- Extract this Attribute from History Bundle
                              ,rc         =RC)
!
        CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE                &  !<-- The Bundle of output data
                              ,name       ='LM'                         &  !<-- Name of the Attribute to extract
                              ,valueList  =wrt_int_state%LM             &  !<-- Extract this Attribute from History Bundle
                              ,rc         =RC)
!
        CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE                &  !<-- The Bundle of output data
                              ,name       ='GLOBAL'                     &  !<-- Name of the Attribute to extract
                              ,value      =wrt_int_state%GLOBAL         &  !<-- Extract this Attribute from History Bundle
                              ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        IF(wrt_int_state%GLOBAL) THEN                                      !<-- Increase lateral dimensions by 2 for global runs
          wrt_int_state%IM(1)=wrt_int_state%IM(1)+2
          wrt_int_state%JM(1)=wrt_int_state%JM(1)+2
        ENDIF
!
!-----------------------------------------------------------------------
!***  Now extract local subdomain limits.
!***  These will be used to allocate the working array to hold fields
!***  on each subdomain prior to quilting them together.
!***  We first need the number of forecast tasks since that
!***  determines the size of the arrays holding the local
!***  subdomain limits.
!
!***  Also extract the halo depths since they are needed for
!***  excluding halo points from the final output data.
!
!***  These values are not to be written to the output files so
!***  they were not inserted into the data Bundles inside the
!***  Write component's import state.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Local Quilting Info from Write Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!

        CALL ESMF_AttributeGet(state=IMP_STATE_WRITE                    &  !<-- The Write component's import state
                              ,name ='INPES'                            &  !<-- Name of the Attribute to extract
                              ,value=INPES(1)                           &  !<-- Extract this Attribute from import state
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=IMP_STATE_WRITE                    &  !<-- The Write component's import state
                              ,name ='JNPES'                            &  !<-- Name of the Attribute to extract
                              ,value=JNPES(1)                           &  !<-- Extract this Attribute from import state
                              ,rc   =RC)
!
        wrt_int_state%INPES=INPES(1)                                       !<-- Place in internal state for later use
        wrt_int_state%JNPES=JNPES(1)                                       !<-- Place in internal state for later use
!
        CALL ESMF_AttributeGet(state=IMP_STATE_WRITE                    &  !<-- The Write component's import state
                              ,name ='IHALO'                            &  !<-- Name of the Attribute to extract
                              ,value=IHALO(1)                           &  !<-- Extract this Attribute from import state
                              ,rc   =RC)
!
        CALL ESMF_AttributeGet(state=IMP_STATE_WRITE                    &  !<-- The Write component's import state
                              ,name ='JHALO'                            &  !<-- Name of the Attribute to extract
                              ,value=JHALO(1)                           &  !<-- Extract this Attribute from import state
                              ,rc   =RC)
!
        wrt_int_state%IHALO=IHALO(1)                                       !<-- Place in internal state for later use
        wrt_int_state%JHALO=JHALO(1)                                       !<-- Place in internal state for later use
!
        CALL ESMF_AttributeGet(state    =IMP_STATE_WRITE                &  !<-- The Write component's import state
                              ,name     ='LOCAL_ISTART'                 &  !<-- Name of the Attribute to extract
                              ,valueList=LOCAL_ISTART                   &  !<-- Extract local subdomain starting I's
                              ,itemCount=NUM_PES_FCST                   &  !<-- Length of Attribute
                              ,rc       =RC)
!
        CALL ESMF_AttributeGet(state    =IMP_STATE_WRITE                &  !<-- The Write component's import state
                              ,name     ='LOCAL_IEND'                   &  !<-- Name of the Attribute to extract
                              ,valueList= LOCAL_IEND                    &  !<-- Extract local subdomain ending I's
                              ,itemCount=NUM_PES_FCST                   &  !<-- Length of Attribute
                              ,rc       =RC)
!
        CALL ESMF_AttributeGet(state    =IMP_STATE_WRITE                &  !<-- The Write component's import state
                              ,name     ='LOCAL_JSTART'                 &  !<-- Name of the Attribute to extract
                              ,valueList=LOCAL_JSTART                   &  !<-- Extract local subdomain starting J's
                              ,itemCount=NUM_PES_FCST                   &  !<-- Length of Attribute
                              ,rc       =RC)
!
        CALL ESMF_AttributeGet(state    =IMP_STATE_WRITE                &  !<-- The Write component's import state
                              ,name     ='LOCAL_JEND'                   &  !<-- Name of the Attribute to extract
                              ,valueList=LOCAL_JEND                     &  !<-- Extract local subdomain ending J's
                              ,itemCount=NUM_PES_FCST                   &  !<-- Length of Attribute
                              ,rc       =RC)

! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        DO N=0,LAST_FCST_TASK
          wrt_int_state%LOCAL_ISTART(N)=LOCAL_ISTART(N)
          wrt_int_state%LOCAL_IEND  (N)=LOCAL_IEND(N)
          wrt_int_state%LOCAL_JSTART(N)=LOCAL_JSTART(N)
          wrt_int_state%LOCAL_JEND  (N)=LOCAL_JEND(N)
        ENDDO
!
        ITS=LOCAL_ISTART(MYPE_DOMAIN)
        ITE=LOCAL_IEND(MYPE_DOMAIN)
        JTS=LOCAL_JSTART(MYPE_DOMAIN)
        JTE=LOCAL_JEND(MYPE_DOMAIN)
!
        DEALLOCATE(LOCAL_ISTART)
        DEALLOCATE(LOCAL_IEND  )
        DEALLOCATE(LOCAL_JSTART)
        DEALLOCATE(LOCAL_JEND  )
!
!-----------------------------------------------------------------------
!
      ENDIF domain_limits
!
!-----------------------------------------------------------------------
!***  Forecast task 0 sends the domain size information
!***  to the first Write task in each Write group because 
!***  the Write tasks need to know this to assemble the
!***  final gridded data.
!-----------------------------------------------------------------------
!
      n_groups_1: DO N=1,NUM_WRITE_GROUPS
!
!-----------------------------------------------------------------------
!
        N1=LEAD_WRITE_TASK(N)
        N2=LAST_WRITE_TASK(N)
!
!-----------------------------------------------------------------------
!                            -- IM --
!-----------------------------------------------------------------------
!
        IF(MYPE_DOMAIN==0)THEN                                             !<-- Forecast task 0 sends
          DO NN=N1,N2     
            CALL MPI_SEND(wrt_int_state%IM                              &  !<-- Send this data
                         ,1                                             &  !<-- Number of words sent
                         ,MPI_INTEGER                                   &  !<-- Datatype
                         ,NN                                            &  !<-- Send to each of the write tasks (domain IDs)
                         ,0                                             &  !<-- An MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR)
!
            IF(IERR/=0)WRITE(0,*)' Failed to send IM from fcst task 0 to write tasks'
!
          ENDDO
        ENDIF 
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN                        !<-- Write tasks in this group receive
          CALL MPI_RECV(wrt_int_state%IM                                &  !<-- Recv this data
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Datatype
                       ,0                                               &  !<-- Recv from fcst task 0
                       ,0                                               &  !<-- An MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
!
          IF(IERR/=0)WRITE(0,*)' Write tasks failed to receive IM from fcst task0'
!
        ENDIF
!
!-----------------------------------------------------------------------
!                          -- JM --
!-----------------------------------------------------------------------
!
        IF(MYPE_DOMAIN==0)THEN                                             !<-- Forecast task 0 sends
          DO NN=N1,N2                                               
            CALL MPI_SEND(wrt_int_state%JM                              &  !<-- Send this data
                         ,1                                             &  !<-- Number of words sent
                         ,MPI_INTEGER                                   &  !<-- Datatype
                         ,NN                                            &  !<-- Send to each of the write tasks (local IDs)
                         ,0                                             &  !<-- An MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR)
!
            IF(IERR/=0)WRITE(0,*)' Failed to send JM from fcst task0 to write tasks'
!
          ENDDO
        ENDIF 
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN                        !<-- Write tasks in this group receive
          CALL MPI_RECV(wrt_int_state%JM                                &  !<-- Recv this data
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Datatype
                       ,0                                               &  !<-- Recv from fcst task 0
                       ,0                                               &  !<-- An MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
!
          IF(IERR/=0)WRITE(0,*)' Write tasks failed to receive JM from fcst task0'
!
        ENDIF
!
!-----------------------------------------------------------------------
!                          -- LM --
!-----------------------------------------------------------------------
!
        IF(MYPE_DOMAIN==0)THEN                                             !<-- Forecast task 0 sends
          DO NN=N1,N2                                               
            CALL MPI_SEND(wrt_int_state%LM                              &  !<-- Send this data
                         ,1                                             &  !<-- Number of words sent
                         ,MPI_INTEGER                                   &  !<-- Datatype
                         ,NN                                            &  !<-- Send to each of the write tasks (local IDs)
                         ,0                                             &  !<-- An MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR)
!
            IF(IERR/=0)WRITE(0,*)' Failed to send LM from fcst task0 to write tasks'
!
          ENDDO
        ENDIF 
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN                        !<-- Write tasks in this group receive
          CALL MPI_RECV(wrt_int_state%LM                                &  !<-- Recv this data
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Datatype
                       ,0                                               &  !<-- Recv from fcst task 0
                       ,0                                               &  !<-- An MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR)
!
          IF(IERR/=0)WRITE(0,*)' Write tasks failed to receive LM from fcst task0'
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDDO n_groups_1
!
!-----------------------------------------------------------------------
!
      IM=wrt_int_state%IM(1)
      JM=wrt_int_state%JM(1)
!
!-----------------------------------------------------------------------
!***  The number of Attributes (for scalars and 1D arrays) and
!***  Fields (for gridded 2D arrays) in the Write component's
!***  import state are not known a priori.  In order to transfer
!***  them to the Write tasks, extract the number of each of
!***  them along with their names.  The scalars can be lumped in
!***  with the 1D arrays at this point.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  All integer quantities (as 1D arrays) and 1D and 2D real
!***  quantities will be strung together in single arrays of 
!***  each particular type.  Arrays that will hold the length of  
!***  each of the quantities in these 'strings' were allocated
!***  in WRT_INIT.
!-----------------------------------------------------------------------
!
      KOUNT_I1D_X=0
      KOUNT_R1D_X=0
      KOUNT_LOG_X=0
!
      LENGTH_SUM_I1D_X=0
      LENGTH_SUM_R1D_X=0
      LENGTH_SUM_LOG_X=0
!
      NCHAR_I1D=0
      NCHAR_R1D=0
      NCHAR_LOG=0
!
!-----------------------------------------------------------------------
!
      fcst_tasks_2: IF(MYPE_DOMAIN<=LAST_FCST_TASK)THEN                    !<-- Only forecast tasks will extract output information
                                                                           !    from the import state because only they participated
                                                                           !    in filling the import state in the Solver component.
!
!-----------------------------------------------------------------------
!***  First find the number of Attributes in the output data Bundle
!***  in the import state and then find their names, lengths, and
!***  datatypes.
!***  Extract the integer and real data and pack it into integer
!***  and real buffers.  Later the buffers will be sent from the
!***  Forecast tasks (the only ones who can see the original
!***  data) to the write tasks.
!
!***  The fact that the Attribute output data is being collected
!***  here in a block that executes only once per Write group
!***  implies the assumption that only the 2D/3D data
!***  associated with the forecast grid can change with time.
!***  If any scalar/1D Attribute data change with time then
!***  this must be moved out of this routine and into the Run step.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Get Attribute Count from "//BUNDLE_NAME
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE                &  !<-- The write component's history data Bundle
                              ,count      =NUM_ATTRIB                   &  !<-- # of Attributes in the history data Bundle
                              ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
        attribute_loop: DO N=1,NUM_ATTRIB                                  !<-- Loop through all the Attributes
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Attribute Names, Datatypes, Lengths"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(FIELDBUNDLE   =OUTPUT_BUNDLE           &  !<-- The write component's history data Bundle
                                ,attributeIndex=N                       &  !<-- Index of each Attribute
                                ,name          =ATTRIB_NAME             &  !<-- Each Attribute's name
                                ,typekind      =DATATYPE                &  !<-- Each Attribute's ESMF Datatype
                                ,itemCount     =LENGTH                  &  !<-- Each Attribute's length
                                ,rc            =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!                 -- Scalar and 1-D Integer Output Data --
!-----------------------------------------------------------------------
!
          IF(DATATYPE==ESMF_TYPEKIND_I4)THEN                               !<-- Extract integer data with rank <2
!
            ALLOCATE(WORK_ARRAY_I1D(LENGTH),stat=RC)                       !<-- This length is from the preceding call 
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Get Scalar/1-D Integer Data from "//BUNDLE_NAME
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE            &  !<-- The write component's history data Bundle
                                  ,name       =ATTRIB_NAME              &  !<-- Name of the Attribute to extract
                                  ,itemCount  =LENGTH                   &  !<-- Length of Attribute
                                  ,valueList  =WORK_ARRAY_I1D           &  !<-- Place the Attribute here
                                  ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            KOUNT_I1D_X=KOUNT_I1D_X+1                                      !<-- Count # of integer Attributes
!
            NPOSN_END=KOUNT_I1D_X*ESMF_MAXSTR
            NPOSN_START=NPOSN_END-ESMF_MAXSTR+1     
            NCHAR_I1D=NCHAR_I1D+ESMF_MAXSTR                                !<-- Save #of characters in all scalar/1D integer names.
                                                                           !    Note that each name is being given
                                                                           !    EMSF_MAXSTR total spaces.
!
            DO L=1,LENGTH
              ALL_DATA_I1D(LENGTH_SUM_I1D_X+L)=WORK_ARRAY_I1D(L)           !<-- String together the integer data
            ENDDO
!
            LENGTH_SUM_I1D_X=LENGTH_SUM_I1D_X+LENGTH                       !<-- Total word sum of scalar/1D integer data
!
            NAMES_I1D_STRING(NPOSN_START:NPOSN_END)=ATTRIB_NAME            !<-- Save the 1D integer names
            LENGTH_DATA_I1D(KOUNT_I1D_X)=LENGTH                            !<-- Store length of each individual integer variable
!
            DEALLOCATE(WORK_ARRAY_I1D)
!
!-----------------------------------------------------------------------
!                  -- Scalar and 1-D Real Output Data --
!-----------------------------------------------------------------------
!
          ELSEIF(DATATYPE==ESMF_TYPEKIND_R4)THEN                           ! <-- Extract real data with rank <2 as Attributes
!
            ALLOCATE(WORK_ARRAY_R1D(LENGTH),stat=RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Get Scalar/1-D Real Data from "//BUNDLE_NAME
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE            &  !<-- The write component's history data Bundle
                                  ,name       =ATTRIB_NAME              &  !<-- Name of the Attribute to extract
                                  ,itemCount  =LENGTH                   &  !<-- Length of Attribute
                                  ,valueList  =WORK_ARRAY_R1D           &  !<-- Place the Attribute here
                                  ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            KOUNT_R1D_X=KOUNT_R1D_X+1                                      !<-- Count # of real Attributes
!
            NPOSN_END=KOUNT_R1D_X*ESMF_MAXSTR
            NPOSN_START=NPOSN_END-ESMF_MAXSTR+1     
            NCHAR_R1D=NCHAR_R1D+ESMF_MAXSTR                                !<-- Save #of characters in all scalar/1D real names
                                                                           !    Note that each name is being given
                                                                           !    EMSF_MAXSTR total spaces
!
            DO L=1,LENGTH
              ALL_DATA_R1D(LENGTH_SUM_R1D_X+L)=WORK_ARRAY_R1D(L)           !<-- String together the real data
            ENDDO
!
            LENGTH_SUM_R1D_X=LENGTH_SUM_R1D_X+LENGTH                       !<-- Total word sum of scalar/1D real data
!
            NAMES_R1D_STRING(NPOSN_START:NPOSN_END)=ATTRIB_NAME            !<-- Save the scalar/1D real names
            LENGTH_DATA_R1D(KOUNT_R1D_X)=LENGTH                            !<-- Store length of each individual real variable
!
            DEALLOCATE(WORK_ARRAY_R1D)
!
!-----------------------------------------------------------------------
!                          -- Logical Data --                       
!-----------------------------------------------------------------------
!
!ratko    ELSEIF(DATATYPE==ESMF_DATA_LOGICAL)THEN                          ! <-- Extract logical data
! --- nothing else than I4 and R4; should FIX later
          ELSE
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Get Logical Data from "//BUNDLE_NAME
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE            &  !<-- The write component's history data Bundle
                                  ,name  =ATTRIB_NAME                   &  !<-- Name of the Attribute to extract
                                  ,value =WORK_LOGICAL                  &  !<-- Place the Attribute here
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            KOUNT_LOG_X=KOUNT_LOG_X+1                                      !<-- Count # of logical Attributes
!
            NPOSN_END=KOUNT_LOG_X*ESMF_MAXSTR
            NPOSN_START=NPOSN_END-ESMF_MAXSTR+1     
            NCHAR_LOG=NCHAR_LOG+ESMF_MAXSTR                                !<-- Save #of characters in all logical names
                                                                           !    Note that each name is being given
                                                                           !    EMSF_MAXSTR total spaces
!
            LENGTH_SUM_LOG_X=LENGTH_SUM_LOG_X+1                            !<-- Total length of all logical data variables
!
            NAMES_LOG_STRING(NPOSN_START:NPOSN_END)=ATTRIB_NAME            !<-- Save the logical names
!
            ALL_DATA_LOG(KOUNT_LOG_X)=WORK_LOGICAL                         !<-- String together the logical data
!
          ENDIF
!
!-----------------------------------------------------------------------
!
        ENDDO attribute_loop
!
!-----------------------------------------------------------------------
!***  Insert number and lengths of scalar/1D integer and real quantities
!***  and logicals into the Write component's internal state.
!-----------------------------------------------------------------------
!
        KOUNT_I1D(1)=KOUNT_I1D_X
        KOUNT_R1D(1)=KOUNT_R1D_X
        KOUNT_LOG(1)=KOUNT_LOG_X
!
        LENGTH_SUM_I1D(1)=LENGTH_SUM_I1D_X
        LENGTH_SUM_R1D(1)=LENGTH_SUM_R1D_X
        LENGTH_SUM_LOG(1)=LENGTH_SUM_LOG_X
!
!-----------------------------------------------------------------------
!***  Now extract the number of ESMF Fields in the output data Bundle
!***  along with their names.  Save the Field information of the 2-D 
!***  data since it will be needed for extraction from the import
!***  state and the transfer to the write tasks.
!***  Then extract the names of all the Fields in the bundle.  
!***  Also, the number of Field names returned should equal 
!***  the Field count in the preceding call.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Get Field Count from "//BUNDLE_NAME
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(           OUTPUT_BUNDLE               &  !<-- The write component's data Bundle
                                ,fieldCount=NCOUNT_FIELDS(1)            &  !<-- Get total # of Fields in the data Bundle
                                ,rc        =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Extract Field Names from "//BUNDLE_NAME
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_FieldBundleGet(              OUTPUT_BUNDLE            &  !<-- The write component's data Bundle
                                ,fieldNameList=FIELD_NAME               &  !<-- Array of ESMF Field names in the Bundle
                                ,fieldCount   =NUM_FIELD_NAMES          &  !<-- Number of Field names in the Bundle
!BSCCTM1
                                ,itemorderflag=ESMF_ITEMORDER_ADDORDER  &  !<-- to not write output variables in alphabetical order
!BSCCTM1
                                ,rc           =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
        IF(NUM_FIELD_NAMES/=NCOUNT_FIELDS(1))THEN
          WRITE(0,*)' WARNING: Number of Fields in '//BUNDLE_NAME       &
                   ,' output does not equal the number of Field names'
          WRITE(0,*)' They are ',NUM_FIELD_NAMES,' and '            &
                   ,NCOUNT_FIELDS(1),', respectively'
        ENDIF
!
!-----------------------------------------------------------------------
!***  Do a preliminary extraction of the Fields themselves in order to
!***  count the number of real and integer 2D arrays.  
!-----------------------------------------------------------------------
!
        KOUNT_R2D_X=0
        KOUNT_I2D_X=0
        NCHAR_I2D(1)=0
        NCHAR_R2D(1)=0
!
        DO N=1,NCOUNT_FIELDS(1)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Extract Fields from Output Bundle for Counting"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldBundleGet(FIELDBUNDLE=OUTPUT_BUNDLE               &  !<-- The write component's data Bundle
                                  ,fieldName  =FIELD_NAME(N)               &  !<-- The ESMF Field's name
                                  ,field      =FIELD_WORK1                 &  !<-- The ESMF Field taken from the Bundle
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Datatype of Fields for Counting Real/Integer"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_FieldGet(field   =FIELD_WORK1                       &  !<-- The ESMF 2D Field
                            ,typekind=DATATYPE                          &  !<-- The Field's ESMF Datatype
                            ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(DATATYPE==ESMF_TYPEKIND_I4)THEN
            KOUNT_I2D_X=KOUNT_I2D_X+1                                      !<-- Add up the total number of integer 2D Fields
!
            IF(KOUNT_I2D_X>MAX_DATA_I2D)THEN
              WRITE(0,*)' FATAL: YOU HAVE EXCEEDED MAX NUMBER OF INTEGER 2D FIELDS FOR OUTPUT'
              WRITE(0,*)' YOU MUST INCREASE VALUE OF MAX_DATA_I2D WHICH NOW EQUALS ',MAX_DATA_I2D
            ENDIF
!
            NPOSN_END  =KOUNT_I2D_X*ESMF_MAXSTR
            NPOSN_START=NPOSN_END-ESMF_MAXSTR+1
            NAMES_I2D_STRING(NPOSN_START:NPOSN_END)=FIELD_NAME(N)          !<-- Save the 2D integer Field names 
                                                                           !    in one long string.
            NCHAR_I2D(1)=NCHAR_I2D(1)+ESMF_MAXSTR
!
          ELSEIF(DATATYPE==ESMF_TYPEKIND_R4)THEN
            KOUNT_R2D_X=KOUNT_R2D_X+1                                      !<-- Add up the total number of real 2D Fields
!
            IF(KOUNT_R2D_X>MAX_DATA_R2D)THEN
              WRITE(0,*)' FATAL: YOU HAVE EXCEEDED MAX NUMBER OF REAL 2D FIELDS FOR OUTPUT'
              WRITE(0,*)' YOU MUST INCREASE VALUE OF MAX_DATA_R2D WHICH NOW EQUALS ',MAX_DATA_R2D
              CALL ESMF_Finalize(endflag=ESMF_END_ABORT             &
                                ,rc             =RC )
            ENDIF
!
            NPOSN_END  =KOUNT_R2D_X*ESMF_MAXSTR
            NPOSN_START=NPOSN_END-ESMF_MAXSTR+1
            NAMES_R2D_STRING(NPOSN_START:NPOSN_END)=FIELD_NAME(N)          !<-- Save the 2D real Field names 
                                                                           !    in one long string.
            NCHAR_R2D(1)=NCHAR_R2D(1)+ESMF_MAXSTR
!
          ENDIF
!
        ENDDO
!
        KOUNT_R2D(1)=KOUNT_R2D_X
        KOUNT_I2D(1)=KOUNT_I2D_X
!
!-----------------------------------------------------------------------
!***  Compute the total number of words for all 2D and 3D real data
!***  and allocate a datastring to that length.  It will transfer
!***  the 2D/3D real data from forecast to Write tasks.
!-----------------------------------------------------------------------
!
        NUM_WORDS_TOT=(ITE-ITS+1+2*IHALO(1))*(JTE-JTS+1+2*JHALO(1))     &
                      *KOUNT_R2D_X
!
        IF(NUM_WORDS_TOT>2147483647)THEN
          WRITE(0,*)' You have TOO MANY words in your datastring.'
          WRITE(0,*)' You must increase the number of tasks.'
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT                 &
                            ,rc             =RC  )
        ELSE
          NUM_WORDS_SEND_R2D=NUM_WORDS_TOT
          NUM_WORDS=NUM_WORDS_SEND_R2D
!
          IF(OUTPUT_FLAG=='History')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%ALL_DATA_R2D))THEN
              ALLOCATE(wrt_int_state%ALL_DATA_R2D(NUM_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Fcst task FAILED to allocate ALL_DATA_R2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT           &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_R2D=>wrt_int_state%ALL_DATA_R2D
            ENDIF
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%RST_ALL_DATA_R2D))THEN
              ALLOCATE(wrt_int_state%RST_ALL_DATA_R2D(NUM_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Fcst task FAILED to allocate RST_ALL_DATA_R2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT           &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_R2D=>wrt_int_state%RST_ALL_DATA_R2D
            ENDIF
!
          ENDIF
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  Likewise for 2D integer data.
!-----------------------------------------------------------------------
!
        NUM_WORDS_TOT=(ITE-ITS+1+2*IHALO(1))*(JTE-JTS+1+2*JHALO(1))     &
                      *KOUNT_I2D_X
!
        IF(NUM_WORDS_TOT>2147483647)THEN
          WRITE(0,*)' You have TOO MANY words in your datastring.'
          WRITE(0,*)' You must increase the number of tasks.'
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT                 &
                            ,rc             =RC  )
        ELSE
          NUM_WORDS_SEND_I2D=NUM_WORDS_TOT
          NUM_WORDS=NUM_WORDS_SEND_I2D
!
          IF(OUTPUT_FLAG=='History')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%ALL_DATA_I2D))THEN
              ALLOCATE(wrt_int_state%ALL_DATA_I2D(NUM_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Fcst task FAILED to allocate ALL_DATA_I2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT           &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_I2D=>wrt_int_state%ALL_DATA_I2D
            ENDIF
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%RST_ALL_DATA_I2D))THEN
              ALLOCATE(wrt_int_state%RST_ALL_DATA_I2D(NUM_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Fcst task FAILED to allocate RST_ALL_DATA_I2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT           &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_I2D=>wrt_int_state%RST_ALL_DATA_I2D
            ENDIF
!
          ENDIF
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDIF fcst_tasks_2
!
!-----------------------------------------------------------------------
!***  If there are no quantities specified for history output,
!***  forecast task 0 will inform the write tasks and then
!***  everyone will return.
!-----------------------------------------------------------------------
!
      NO_FIELDS=.FALSE.
!
!-----------------------------------------------------------------------
      n_groups_2: DO N=1,NUM_WRITE_GROUPS
!-----------------------------------------------------------------------
!
        N1=LEAD_WRITE_TASK(N)                                              !<-- The lead write task in group N
        N2=LAST_WRITE_TASK(N)                                              !<-- The last write task in group N
!
        IF(MYPE_DOMAIN==0)THEN
          IF(NCOUNT_FIELDS(1)==0)NO_FIELDS=.TRUE.                          !<-- Reset flag saying there are no history quantities
!
          DO NN=N1,N2                                                      !<-- Loop through all the write tasks in the write group
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Fcst Task0 Informs All That There Are No Fields"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL MPI_SEND(NO_FIELDS                                     &  !<-- Send flag that there is no history data
                         ,1                                             &  !<-- The flag is a scalar
                         ,MPI_LOGICAL                                   &  !<-- The flag is logical
                         ,NN                                            &  !<-- Receiving task in write group N
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )          
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          ENDDO
!
        ENDIF
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN                        !<-- All write tasks in this group receive
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Write Tasks Told By Fcst Task0 There Are No Fields"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_RECV(NO_FIELDS                                       &  !<-- Recv flag that there is no history data
                       ,1                                               &  !<-- The flag is a scalar
                       ,MPI_LOGICAL                                     &  !<-- The flag is logicallar
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )         
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        ENDIF
!
      ENDDO n_groups_2
!
!-----------------------------------------------------------------------
!
      IF(NO_FIELDS)THEN
        IF(MYPE_DOMAIN==0)THEN
          WRITE(6,*)'WARNING: No Import ESMF quantities for the Write Component'
          WRITE(0,*)'WARNING: No Import ESMF quantities for the Write Component'
        ENDIF
!
        RETURN                                                             !<-- All tasks return if there is no history output
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Forecast task 0 sends all the write tasks the number of
!***  real and integer 2D gridded quantities plus all of the
!***  local horizontal domain limits in preparation for the
!***  Write tasks' receiving and assembling the local history
!***  data they receive from the Forecast tasks.
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
      n_groups_3: DO N=1,NUM_WRITE_GROUPS
!-----------------------------------------------------------------------
!
        N1=LEAD_WRITE_TASK(N)
        N2=LAST_WRITE_TASK(N)
!
!-----------------------------------------------------------------------
!
        task_0: IF(MYPE_DOMAIN==0)THEN                                     !<-- Forecast task 0 sends
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Fcst Task0 Sends Write Tasks Info for Quilting"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          DO NN=N1,N2                                                      !<-- Loop through all the write tasks in the write group
!
            CALL MPI_SEND(INPES                                         &  !<-- Send # of fcst tasks in I
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(JNPES                                         &  !<-- Send # of fcst tasks in J
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(IHALO                                         &  !<-- Send # of points in the east-west halo
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(JHALO                                         &  !<-- Send # of points in the south-north halo
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(NCOUNT_FIELDS                                 &  !<-- Send # of Fields in history data
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(KOUNT_R2D                                     &  !<-- Send # of real Fields in history data
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(KOUNT_I2D                                     &  !<-- Send # of integer Fields in history data
                         ,1                                             &  !<-- Number is one word
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(wrt_int_state%LOCAL_ISTART                    &  !<-- Send starting I for all fcst task subdomains
                         ,NUM_PES_FCST                                  &  !<-- Number of words
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(wrt_int_state%LOCAL_IEND                      &  !<-- Send ending I for all fcst task subdomains
                         ,NUM_PES_FCST                                  &  !<-- Number of words
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(wrt_int_state%LOCAL_JSTART                    &  !<-- Send starting J for all fcst task subdomains
                         ,NUM_PES_FCST                                  &  !<-- Number of words
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
            CALL MPI_SEND(wrt_int_state%LOCAL_JEND                      &  !<-- Send starting J for all fcst task subdomains
                         ,NUM_PES_FCST                                  &  !<-- Number of words
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,NN                                            &  !<-- Receiving task in active write group
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,IERR )
!
          ENDDO
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Fcst Task0 Sends Lead Write Task # of BC Words"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_SEND(wrt_int_state%NUM_WORDS_SEND_BC                 &  !<-- Send # of words in BC data
                       ,1                                               &  !<-- Send one word
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,N1                                              &  !<-- Receiving task in active write group
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!
        ENDIF task_0
!
!-----------------------------------------------------------------------
!
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN                        !<-- All write tasks in this group receive
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Write Tasks Recv Quilting Info From Fcst Task0"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_RECV(INPES                                           &  !<-- Recv # of fcst tasks in I
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(JNPES                                           &  !<-- Recv # of fcst tasks in J
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(IHALO                                           &  !<-- Recv width of halo in I
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(JHALO                                           &  !<-- Recv width of halo in J
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          wrt_int_state%IHALO=IHALO(1)
          wrt_int_state%JHALO=JHALO(1)
!
          CALL MPI_RECV(NCOUNT_FIELDS                                   &  !<-- Recv # of Fields in history data
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(KOUNT_R2D                                       &  !<-- Recv # of real Fields in history data
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(KOUNT_I2D                                       &  !<-- Recv # of integer Fields in history data
                       ,1                                               &  !<-- Data is a scalar
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(wrt_int_state%LOCAL_ISTART                      &  !<-- Recv starting I of each fcst task subdomain
                       ,NUM_PES_FCST                                    &  !<-- # of words in data
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(wrt_int_state%LOCAL_IEND                        &  !<-- Recv ending I of each fcst task subdomain
                       ,NUM_PES_FCST                                    &  !<-- # of words in data
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(wrt_int_state%LOCAL_JSTART                      &  !<-- Recv starting J of each fcst task subdomain
                       ,NUM_PES_FCST                                    &  !<-- # of words in data
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(wrt_int_state%LOCAL_JEND                        &  !<-- Recv ending J of each fcst task subdomain
                       ,NUM_PES_FCST                                    &  !<-- # of words in data
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (forecast task 0)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(MYPE_DOMAIN==N1)THEN                                          !<-- Lead write task in each group must recv BC word count
!
            IF(ALLOCATED(wrt_int_state%NUM_WORDS_SEND_BC))THEN
!             write(0,*)' PRELIM_INFO wrt_int_state%NUM_WORDS_SEND_BC already allocated for write group ',n
            ELSE
!             WRITE(0,*)' PRELIM_INFO must allocate wrt_int_state%NUM_WORDS_SEND_BC'
              ALLOCATE(wrt_int_state%NUM_WORDS_SEND_BC(1),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Failed to allocate wrt_int_state%NUM_WORDS_SEND_BC in PRELIM_INFO'
              ENDIF
            ENDIF
!
            CALL MPI_RECV(wrt_int_state%NUM_WORDS_SEND_BC               &  !<-- Recv # of BC words
                         ,1                                             &  !<-- Data is a scalar
                         ,MPI_INTEGER                                   &  !<-- Data is integer
                         ,0                                             &  !<-- Sending task (forecast task 0)
                         ,0                                             &  !<-- MPI tag
                         ,COMM_MY_DOMAIN                                &  !<-- MPI domain communicator
                         ,JSTAT                                         &  !<-- MPI status object
                         ,IERR )
!
            IF(ALLOCATED(wrt_int_state%RST_ALL_BC_DATA))THEN
!             WRITE(0,*)' PRELIM_INFO wrt_int_state%RST_ALL_BC_DATA already allocated for write group ',n
            ELSE
!             WRITE(0,*)' PRELIM_INFO must allocate wrt_int_state%RST_ALL_BC_DATA'
              ALLOCATE(wrt_int_state%RST_ALL_BC_DATA(1:wrt_int_state%NUM_WORDS_SEND_BC(1)),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Failed to allocate wrt_int_state%wrt_int_state%RST_ALL_BC_DATA in PRELIM_INFO'
              ENDIF
            ENDIF
!
          ENDIF
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  Forecast task 0 sends the 2D data names to the lead Write task.
!-----------------------------------------------------------------------
!
        IF(MYPE_DOMAIN==0)THEN                                             !<-- Fcst task 0 sends data names
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Fcst Task0 Sends Lead Write Task 2D Data Names"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_SEND(NCHAR_I2D                                       &  !<-- Send total length of the names of 2D integer data
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,N1                                              &  !<-- Receiving task (lead write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,IERR )
!
          CALL MPI_SEND(NAMES_I2D_STRING                                &  !<-- Send names of 2D integer history variables
                       ,NCHAR_I2D(1)                                    &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,N1                                              &  !<-- Receiving task (lead write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,IERR )
!
          CALL MPI_SEND(NCHAR_R2D                                       &  !<-- Send total length of the names of 2D real data
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,N1                                              &  !<-- Receiving task (lead write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,IERR )
!
          CALL MPI_SEND(NAMES_R2D_STRING                                &  !<-- Send names of 2D real history variables
                       ,NCHAR_R2D(1)                                    &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,N1                                              &  !<-- Receiving task (lead write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,IERR )
!
        ELSEIF(MYPE_DOMAIN==N1)THEN                                        !<-- Lead write task receives 2D preliminary info
!
          CALL MPI_RECV(NCHAR_I2D                                       &  !<-- Recv total length of the names of 2D integer data
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(NAMES_I2D_STRING                                &  !<-- Recv names of 2D integer history variables
                       ,NCHAR_I2D(1)                                    &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(NCHAR_R2D                                       &  !<-- Recv total length of the names of 2D real data
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(NAMES_R2D_STRING                                &  !<-- Recv names of 2D real history variables
                       ,NCHAR_R2D(1)                                    &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  Each Write task must know the IDs of the Forecast tasks
!***  from which it will receive 2D gridded history data.
!-----------------------------------------------------------------------
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN                        !<-- The write tasks
!
          M1=LEAD_WRITE_TASK(1)                                            !<-- Local rank of lead write task
          M2=LAST_WRITE_TASK(1)                                            !<-- Local rank of last write task
          LOCAL_ID=M1+MYPE_DOMAIN-LEAD_WRITE_TASK(N)                       !<-- Local rank of every write task
!
          IF(.NOT.ALLOCATED(wrt_int_state%ID_FTASK_RECV_STA))THEN
            ALLOCATE(wrt_int_state%ID_FTASK_RECV_STA(M1:M2))
            ALLOCATE(wrt_int_state%ID_FTASK_RECV_END(M1:M2))
          ENDIF
!
          NY=0
          DO NX=M1,M2
            NY=NY+1
            CALL PARA_RANGE(JNPES(1),NWTPG,NY                           &  !<-- Find each write task's first and last rows of
                           ,JROW_FIRST,JROW_LAST)                          !    fcst tasks from which it will recv.
!
            wrt_int_state%ID_FTASK_RECV_STA(NX)=(JROW_FIRST-1)*INPES(1)    !<-- First fcst task that sends to this write task
            wrt_int_state%ID_FTASK_RECV_END(NX)=JROW_LAST*INPES(1)-1       !<-- Last fcst task that sends to this write task
          ENDDO
!
!-----------------------------------------------------------------------
!***  Each write task computes the number of words in the datastring
!***  of 2D/3D real history data it will receive from each Forecast
!***  task it is associated with.  Then allocate that datastring.
!-----------------------------------------------------------------------
!
          IF(OUTPUT_FLAG=='History')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%NUM_WORDS_RECV_R2D_HST))THEN
              N_STA=wrt_int_state%ID_FTASK_RECV_STA(LOCAL_ID)
              N_END=wrt_int_state%ID_FTASK_RECV_END(LOCAL_ID)
              ALLOCATE(wrt_int_state%NUM_WORDS_RECV_R2D_HST(N_STA:N_END))
              NUM_WORDS_RECV_R2D=>wrt_int_state%NUM_WORDS_RECV_R2D_HST
            ENDIF
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%NUM_WORDS_RECV_R2D_RST))THEN
              N_STA=wrt_int_state%ID_FTASK_RECV_STA(LOCAL_ID)
              N_END=wrt_int_state%ID_FTASK_RECV_END(LOCAL_ID)
              ALLOCATE(wrt_int_state%NUM_WORDS_RECV_R2D_RST(N_STA:N_END))
              NUM_WORDS_RECV_R2D=>wrt_int_state%NUM_WORDS_RECV_R2D_RST
            ENDIF
!
          ENDIF
!
          MAX_WORDS=0
!
          DO NX=wrt_int_state%ID_FTASK_RECV_STA(LOCAL_ID)               &  !<-- The fcst tasks sending to this write task
               ,wrt_int_state%ID_FTASK_RECV_END(LOCAL_ID)                  !<--
!
            ITS=wrt_int_state%LOCAL_ISTART(NX)
            ITE=wrt_int_state%LOCAL_IEND  (NX)
            JTS=wrt_int_state%LOCAL_JSTART(NX)
            JTE=wrt_int_state%LOCAL_JEND  (NX)
!
            NUM_WORDS_TOT=(ITE-ITS+1+2*IHALO(1))*(JTE-JTS+1+2*JHALO(1)) &  !<-- # of words of 2D/3D real history data from fcst task NX
                          *KOUNT_R2D(1)
!
            NUM_WORDS_RECV_R2D(NX)=NUM_WORDS_TOT
            MAX_WORDS=MAX(MAX_WORDS                                     &  !<-- Max # of integer words from any fcst tasks
                         ,NUM_WORDS_RECV_R2D(NX))                          !
          ENDDO
!
          IF(OUTPUT_FLAG=='History')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%ALL_DATA_R2D))THEN
              ALLOCATE(wrt_int_state%ALL_DATA_R2D(MAX_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Write task FAILED to allocate ALL_DATA_R2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT             &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_R2D=>wrt_int_state%ALL_DATA_R2D
            ENDIF
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%RST_ALL_DATA_R2D))THEN
              ALLOCATE(wrt_int_state%RST_ALL_DATA_R2D(MAX_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Write task FAILED to allocate RST_ALL_DATA_R2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT             &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_R2D=>wrt_int_state%RST_ALL_DATA_R2D
            ENDIF
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  Likewise for the 2-D integer data.
!-----------------------------------------------------------------------
!
          N_STA=wrt_int_state%ID_FTASK_RECV_STA(LOCAL_ID)
          N_END=wrt_int_state%ID_FTASK_RECV_END(LOCAL_ID)
!
          IF(OUTPUT_FLAG=='History')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%NUM_WORDS_RECV_I2D_HST))THEN
              ALLOCATE(wrt_int_state%NUM_WORDS_RECV_I2D_HST(N_STA:N_END))
              NUM_WORDS_RECV_I2D=>wrt_int_state%NUM_WORDS_RECV_I2D_HST
            ENDIF
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%NUM_WORDS_RECV_I2D_RST))THEN
              ALLOCATE(wrt_int_state%NUM_WORDS_RECV_I2D_RST(N_STA:N_END))
              NUM_WORDS_RECV_I2D=>wrt_int_state%NUM_WORDS_RECV_I2D_RST
            ENDIF
          ENDIF
!
          MAX_WORDS=0
!
          DO NX=wrt_int_state%ID_FTASK_RECV_STA(LOCAL_ID)               &  !<-- The fcst tasks sending to this write task
              ,wrt_int_state%ID_FTASK_RECV_END(LOCAL_ID)                   !
!
            ITS=wrt_int_state%LOCAL_ISTART(NX)
            ITE=wrt_int_state%LOCAL_IEND  (NX)
            JTS=wrt_int_state%LOCAL_JSTART(NX)
            JTE=wrt_int_state%LOCAL_JEND  (NX)
!
            NUM_WORDS_TOT=(ITE-ITS+1+2*IHALO(1))*(JTE-JTS+1+2*JHALO(1)) &  !<-- # of words of 2D integer history data from fcst task NX
                          *KOUNT_I2D(1)
!
            NUM_WORDS_RECV_I2D(NX)=NUM_WORDS_TOT
            MAX_WORDS=MAX(MAX_WORDS                                     &  !<-- Max # of real words from all fcst tasks
                         ,NUM_WORDS_RECV_I2D(NX))                          !
          ENDDO
!
          IF(OUTPUT_FLAG=='History')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%ALL_DATA_I2D))THEN
              ALLOCATE(wrt_int_state%ALL_DATA_I2D(MAX_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Write task FAILED to allocate ALL_DATA_I2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT             &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_I2D=>wrt_int_state%ALL_DATA_I2D
            ENDIF
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            IF(.NOT.ASSOCIATED(wrt_int_state%RST_ALL_DATA_I2D))THEN
              ALLOCATE(wrt_int_state%RST_ALL_DATA_I2D(MAX_WORDS),stat=ISTAT)
              IF(ISTAT/=0)THEN
                WRITE(0,*)' Write task FAILED to allocate RST_ALL_DATA_I2D'
                CALL ESMF_Finalize(endflag=ESMF_END_ABORT             &
                                  ,rc             =RC  )
              ENDIF
              ALL_DATA_I2D=>wrt_int_state%RST_ALL_DATA_I2D
            ENDIF
!
          ENDIF
!
!-----------------------------------------------------------------------
!***  Each Write task also must know the North-South extent of the
!***  full 2D domain that it will handle.  This is determined by
!***  the coverage of the Fcst tasks that send to it.
!-----------------------------------------------------------------------
!
          JSTA_WRITE=wrt_int_state%LOCAL_JSTART(wrt_int_state%ID_FTASK_RECV_STA(LOCAL_ID))  !<-- JTS/JTE of the first fcst task
          JEND_WRITE=wrt_int_state%LOCAL_JEND  (wrt_int_state%ID_FTASK_RECV_END(LOCAL_ID))  !    that sends to this write task.
!
!-----------------------------------------------------------------------
!***  Now each Write task allocates its own section of the 2D domain
!***  for all the 2D variables it will receive and its 1D equivalent
!***  used to transfer the data to the lead Write task.
!-----------------------------------------------------------------------
!
          LENGTH=IM*(JEND_WRITE-JSTA_WRITE+1)
!
          IF(OUTPUT_FLAG=='History')THEN
!
            ALLOCATE(wrt_int_state%WRITE_SUBSET_I(1:IM,JSTA_WRITE:JEND_WRITE  &
                                                 ,KOUNT_I2D(1)))
            ALLOCATE(wrt_int_state%BUFF_INT(LENGTH))
            WRITE_SUBSET_I=>wrt_int_state%WRITE_SUBSET_I
            BUFF_INT=>wrt_int_state%BUFF_INT
!
            ALLOCATE(wrt_int_state%WRITE_SUBSET_R(1:IM,JSTA_WRITE:JEND_WRITE  &
                                                 ,KOUNT_R2D(1)))
            ALLOCATE(wrt_int_state%BUFF_REAL(LENGTH))
            WRITE_SUBSET_R=>wrt_int_state%WRITE_SUBSET_R
            BUFF_REAL=>wrt_int_state%BUFF_REAL
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
!
            ALLOCATE(wrt_int_state%RST_WRITE_SUBSET_I(1:IM,JSTA_WRITE:JEND_WRITE  &
                                                     ,KOUNT_I2D(1)))
            ALLOCATE(wrt_int_state%RST_BUFF_INT(LENGTH))
            WRITE_SUBSET_I=>wrt_int_state%RST_WRITE_SUBSET_I
            BUFF_INT=>wrt_int_state%RST_BUFF_INT
!
            ALLOCATE(wrt_int_state%RST_WRITE_SUBSET_R(1:IM,JSTA_WRITE:JEND_WRITE  &
                                                     ,KOUNT_R2D(1)))
            ALLOCATE(wrt_int_state%RST_BUFF_REAL(LENGTH))
            WRITE_SUBSET_R=>wrt_int_state%RST_WRITE_SUBSET_R
            BUFF_REAL=>wrt_int_state%RST_BUFF_REAL
!
          ENDIF
!       
        ENDIF
!
!-----------------------------------------------------------------------
!***  The lead write task allocates its working arrays into which
!***  it will assemble each individual 2D field that will be
!***  written to the history files.
!-----------------------------------------------------------------------
!
        IF(MYPE_DOMAIN==LEAD_WRITE_TASK(N))THEN
!
          IF(OUTPUT_FLAG=='History')THEN
            ALLOCATE(wrt_int_state%OUTPUT_ARRAY_I2D(1:IM,1:JM))
            ALLOCATE(wrt_int_state%OUTPUT_ARRAY_R2D(1:IM,1:JM))
            OUTPUT_ARRAY_I2D=>wrt_int_state%OUTPUT_ARRAY_I2D
            OUTPUT_ARRAY_R2D=>wrt_int_state%OUTPUT_ARRAY_R2D
!
          ELSEIF(OUTPUT_FLAG=='Restart')THEN
            ALLOCATE(wrt_int_state%RST_OUTPUT_ARRAY_I2D(1:IM,1:JM))
            ALLOCATE(wrt_int_state%RST_OUTPUT_ARRAY_R2D(1:IM,1:JM))
            OUTPUT_ARRAY_I2D=>wrt_int_state%RST_OUTPUT_ARRAY_I2D
            OUTPUT_ARRAY_R2D=>wrt_int_state%RST_OUTPUT_ARRAY_R2D
!
          ENDIF
!
        ENDIF
!
!-----------------------------------------------------------------------
!***  Since all scalar/1D data is identical on all forecast tasks,
!***  task 0 alone can send the information to the lead write task
!***  that will later write it to the history file.
!--------------------------------------------------------------------
!
!--------------------------------------------------------------------
        task_0_sends: IF(MYPE_DOMAIN==0)THEN                            !<-- Forecast task 0 sends
!--------------------------------------------------------------------
!
!------------------------------------------------
!***  Send scalar/1D integer history information.
!------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Fcst Task0 Sends Scalar/1D Integer History Data"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_SEND(KOUNT_I1D                                       &  !<-- Send # of scalar/1D integer history variables
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain communicator
                       ,IERR )
!
          CALL MPI_SEND(LENGTH_SUM_I1D                                  &  !<-- Send length of string of all such integer history variables
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
!                      ,0                                               &  !<-- MPI tag
                       ,678                                             &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(LENGTH_DATA_I1D                                 &  !<-- Send lengths of each scalar/1D integer history variable
                       ,KOUNT_I1D(1)                                    &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(NAMES_I1D_STRING                                &  !<-- Send names of each scalar/1D integer history variable
                       ,NCHAR_I1D                                       &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Words are character
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(ALL_DATA_I1D                                    &  !<-- Send the full string of all scalar/1D integer history data
                       ,LENGTH_SUM_I1D(1)                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!---------------------------------------------
!***  Send scalar/1D real history information.
!---------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Fcst Task 0 Sends Scalar/1D Real History Data"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_SEND(KOUNT_R1D                                       &  !<-- Send # of scalar/1D real history variables
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(LENGTH_SUM_R1D                                  &  !<-- Send length of string of all such real history variables
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer     
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(LENGTH_DATA_R1D                                 &  !<-- Send lengths of each scalar/1D real history variable
                       ,KOUNT_R1D(1)                                    &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(NAMES_R1D_STRING                                &  !<-- Send names of each scalar/1D real history variable
                       ,NCHAR_R1D                                       &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Words are character
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(ALL_DATA_R1D                                    &  !<-- Send the full string of all scalar/1D real history data
                       ,LENGTH_SUM_R1D(1)                               &  !<-- Words sent
                       ,MPI_REAL                                        &  !<-- Words are real
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!--------------------------------------
!***  Send logical history information.
!--------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Fcst Task0 Sends Logical History Data"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_SEND(KOUNT_LOG                                       &  !<-- Send # of logical history variables
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(LENGTH_SUM_LOG                                  &  !<-- Send length of string of all logical variables
                       ,1                                               &  !<-- Words sent
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(NAMES_LOG_STRING                                &  !<-- Send names of each logical history variable
                       ,NCHAR_LOG                                       &  !<-- Words sent
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
          CALL MPI_SEND(ALL_DATA_LOG                                    &  !<-- Send the full string of all logical history data
                       ,LENGTH_SUM_LOG(1)                               &  !<-- Words sent
                       ,MPI_LOGICAL                                     &  !<-- Data is logical 
                       ,LEAD_WRITE_TASK(N)                              &  !<-- Receiving task (1st write task in group)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
        ENDIF task_0_sends
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
        write_task_recvs: IF(MYPE_DOMAIN==LEAD_WRITE_TASK(N))THEN          !<-- 1st write task in this group receives
                                                                           !    all of the data just sent to it by
                                                                           !    fcst task 0.
!-----------------------------------------------------------------------
!***  Receive scalar/1D integer history information
!***  from Forecast task 0.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Write Tasks Recv Scalar/1D Integer History Data"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_RECV(KOUNT_I1D                                       &  !<-- Recv # of scalar/1D integer history variables
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(LENGTH_SUM_I1D                                  &  !<-- Recv length of string of all such integer history variables
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,678                                             &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(LENGTH_DATA_I1D                                 &  !<-- Recv lengths of each scalar/1D integer history variable
                       ,KOUNT_I1D(1)                                    &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          NCHAR_I1D=KOUNT_I1D(1)*ESMF_MAXSTR
!
          CALL MPI_RECV(NAMES_I1D_STRING                                &  !<-- Recv names of each scalar/1D integer history variable
                       ,NCHAR_I1D                                       &  !<-- Words received
                       ,MPI_CHARACTER                                   &  !<-- Words are character
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(ALL_DATA_I1D                                    &  !<-- Recv the full string of all scalar/1D integer history data
                       ,LENGTH_SUM_I1D(1)                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Receive scalar/1D real history information.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Write Tasks Recv Scalar/1D Real History Data"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_RECV(KOUNT_R1D                                       &  !<-- Recv # of scalar/1D real history variables
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(LENGTH_SUM_R1D                                  &  !<-- Recv length of string of all such real history variables
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(LENGTH_DATA_R1D                                 &  !<-- Recv lengths of each scalar/1D real history variable
                       ,KOUNT_R1D(1)                                    &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          NCHAR_R1D=KOUNT_R1D(1)*ESMF_MAXSTR
          CALL MPI_RECV(NAMES_R1D_STRING                                &  !<-- Recv names of scalar/1D real history variables
                       ,NCHAR_R1D                                       &  !<-- Words received
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(ALL_DATA_R1D                                    &  !<-- Recv the string of all scalar/1D real history data
                       ,LENGTH_SUM_R1D(1)                               &  !<-- Words received
                       ,MPI_REAL                                        &  !<-- Data is real
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Receive logical history information.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Write Tasks Recv Logical Real History Data"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL MPI_RECV(KOUNT_LOG                                       &  !<-- Recv # of logical history variables
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer  
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(LENGTH_SUM_LOG                                  &  !<-- Recv length of string of all logical history variables
                       ,1                                               &  !<-- Words received
                       ,MPI_INTEGER                                     &  !<-- Data is integer  
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          NCHAR_LOG=KOUNT_LOG(1)*ESMF_MAXSTR
          CALL MPI_RECV(NAMES_LOG_STRING                                &  !<-- Recv names of logical history variables
                       ,NCHAR_LOG                                       &  !<-- Words received
                       ,MPI_CHARACTER                                   &  !<-- Data is character
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
          CALL MPI_RECV(ALL_DATA_LOG                                    &  !<-- Recv the string of all logical history data
                       ,LENGTH_SUM_LOG(1)                               &  !<-- Words received
                       ,MPI_LOGICAL                                     &  !<-- Data is logical  
                       ,0                                               &  !<-- Sending task (lead fcst task)
                       ,0                                               &  !<-- MPI tag
                       ,COMM_MY_DOMAIN                                  &  !<-- MPI domain commumicator
                       ,JSTAT                                           &  !<-- MPI status object
                       ,IERR )
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!
        ENDIF write_task_recvs
!
!-----------------------------------------------------------------------
!
      ENDDO n_groups_3
!
!-----------------------------------------------------------------------
!***  When run post on quilt, all the write tasks need to know the
!***  variables in history bundle that first forecast task sent to
!***  lead write tasks.
!-----------------------------------------------------------------------
!
      IF(WRT_INT_STATE%WRITE_DOPOST.and.OUTPUT_FLAG=='History')THEN
!
      n_groups_4: DO N=1,NUM_WRITE_GROUPS
!-----------------------------------------------------------------------
!
        N1=LEAD_WRITE_TASK(N)
        N2=LAST_WRITE_TASK(N)
!
        IF(MYPE_DOMAIN>=N1.AND.MYPE_DOMAIN<=N2)THEN

!          write(0,*)'bf broadcast NCHAR_I2D'
          CALL MPI_BCAST(NCHAR_I2D,1,MPI_INTEGER,0,MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast NCHAR_I2D=',NCHAR_I2D
          CALL MPI_BCAST(NAMES_I2D_STRING,NCHAR_I2D(1),MPI_CHARACTER,0,   &
                         MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast NAMES_I2D_STRING=',NAMES_I2D_STRING(1:30)
          CALL MPI_BCAST(NCHAR_R2D,1,MPI_INTEGER,0,MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast NCHAR_R2D=',NCHAR_R2D
          CALL MPI_BCAST(NAMES_R2D_STRING,NCHAR_R2D(1),MPI_CHARACTER,0,   &
                         MPI_COMM_COMP,IERR)
!integer
          CALL MPI_BCAST(KOUNT_I1D,1,MPI_INTEGER,0,MPI_COMM_COMP,IERR)
          CALL MPI_BCAST(LENGTH_SUM_I1D,1,MPI_INTEGER,0,MPI_COMM_COMP,   &
                          IERR)
!          write(0,*)'af broadcast LENGTH_SUM_I1D=',LENGTH_SUM_I1D(1)
          CALL MPI_BCAST(LENGTH_DATA_I1D,KOUNT_I1D(1),MPI_INTEGER,0,     &
                          MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast LENGTH_DATA_I1D=',LENGTH_DATA_I1D(1)
          NCHAR_I1D=KOUNT_I1D(1)*ESMF_MAXSTR
          CALL MPI_BCAST(NAMES_I1D_STRING,NCHAR_I1D,MPI_CHARACTER,0,     &
                          MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast NAMES_I1D_STRING=',NAMES_I1D_STRING(1:30)
          CALL MPI_BCAST(ALL_DATA_I1D,LENGTH_SUM_I1D(1),MPI_LOGICAL,0,   &
                          MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast ALL_DATA_I1D=',ALL_DATA_I1D(1:5)
!real
          CALL MPI_BCAST(KOUNT_R1D,1,MPI_INTEGER,0,MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast NCHAR_R1D=',KOUNT_R1D
          CALL MPI_BCAST(LENGTH_SUM_R1D,1,MPI_INTEGER,0,MPI_COMM_COMP,   &
                          IERR)
          CALL MPI_BCAST(LENGTH_DATA_R1D,KOUNT_R1D(1),MPI_INTEGER,0,     &
                          MPI_COMM_COMP,IERR)
          NCHAR_R1D=KOUNT_R1D(1)*ESMF_MAXSTR
          CALL MPI_BCAST(NAMES_R1D_STRING,NCHAR_R1D,MPI_CHARACTER,0,     &
                          MPI_COMM_COMP,IERR)
          CALL MPI_BCAST(ALL_DATA_R1D,LENGTH_SUM_R1D(1),MPI_LOGICAL,0,   &
                 MPI_COMM_COMP,IERR)
!logical
          CALL MPI_BCAST(KOUNT_LOG,1,MPI_INTEGER,0,MPI_COMM_COMP,IERR)
!          write(0,*)'af broadcast NCHAR_LOG=',KOUNT_LOG
          CALL MPI_BCAST(LENGTH_SUM_LOG,1,MPI_INTEGER,0,MPI_COMM_COMP,   &
                          IERR)
          NCHAR_LOG=KOUNT_LOG(1)*ESMF_MAXSTR
          CALL MPI_BCAST(NAMES_LOG_STRING,NCHAR_LOG,MPI_CHARACTER,0,     &
                          MPI_COMM_COMP,IERR)
          CALL MPI_BCAST(ALL_DATA_LOG,LENGTH_SUM_LOG(1),MPI_LOGICAL,0,   &
                          MPI_COMM_COMP,IERR)
!
          ENDIF
!
        ENDDO n_groups_4
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      DEALLOCATE(INPES)
      DEALLOCATE(JNPES)
      DEALLOCATE(IHALO)
      DEALLOCATE(JHALO)
      DEALLOCATE(NCHAR_I2D)
      DEALLOCATE(NCHAR_R2D)
!
!-----------------------------------------------------------------------
!***  All the write tasks now have everything they need with respect to
!***  the nature of the data they will be writing out whenever their
!***  particular write group is invoked.  However for the forecast
!***  tasks only the variables in the internal state of the Write 
!***  component associated with write group #1 have been filled.
!***  So now the write tasks fill those same variables in each of 
!***  the other internal states of the Write components associated 
!***  with the remaining write groups.
!-----------------------------------------------------------------------
!
      IF(MYPE_DOMAIN<=LAST_FCST_TASK                                    &  !<-- Select only the forecast tasks
                 .AND.                                                  &
         NUM_WRITE_GROUPS>1)THEN                                           !<-- Variables in write group #1 already done
!
!-----------------------------------------------------------------------
!
        ALLOCATE(WRT_INT_STATE_X(2:NUM_WRITE_GROUPS),stat=RC)              !<-- Allocate working array of internal states
!
        IF(RC/=0)THEN
          WRITE(0,*)' Failed to allocate working array of'              &
                   ,' internal state pointers!'
          WRITE(0,*)' ABORT!'
          CALL ESMF_Finalize(endflag=ESMF_END_ABORT                 &
                            ,rc             =RC )
        ENDIF
!
!-----------------------------------------------------------------------
!
        DO N=2,NUM_WRITE_GROUPS                                            !<-- Loop through remaining write groups
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="PRELIM_INFO: Fcst Tasks Get Nth Write Internal State"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_GridCompGetInternalState(WRITE_COMPS(N)             &
                                            ,WRAP                       &
                                            ,RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_WRT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          WRT_INT_STATE_X(N)%LOC_INT_STATE=>wrap%WRITE_INT_STATE           !<-- Pointer to internal state of Nth Write component
!
!-----------------------------------------------------------------------
!
          CALL FILL_GROUP_STATES                                           !<-- Fill variables in internal state N from state #1
!
!-----------------------------------------------------------------------
!
        ENDDO
!
        DEALLOCATE(WRT_INT_STATE_X)
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!
      SUBROUTINE POINT_LOCAL
!
!-----------------------------------------------------------------------
!
      IF(OUTPUT_FLAG=='History')THEN
!
        ALLOCATE(wrt_int_state%NUM_WORDS_SEND_I2D_HST)
        ALLOCATE(wrt_int_state%NUM_WORDS_SEND_R2D_HST)
!BSCCTM2
!        ALLOCATE(wrt_int_state%FIELD_NAME(1:5000))
        ALLOCATE(wrt_int_state%FIELD_NAME(1:30000))
!BSCCTM2
        ALLOCATE(wrt_int_state%NAMES_I1D_STRING)
        ALLOCATE(wrt_int_state%NAMES_I2D_STRING)
        ALLOCATE(wrt_int_state%NAMES_R1D_STRING)
        ALLOCATE(wrt_int_state%NAMES_R2D_STRING)
        ALLOCATE(wrt_int_state%NAMES_LOG_STRING)
!
        NUM_WORDS_SEND_I2D=>wrt_int_state%NUM_WORDS_SEND_I2D_HST
        NUM_WORDS_SEND_R2D=>wrt_int_state%NUM_WORDS_SEND_R2D_HST
        KOUNT_I1D=>wrt_int_state%KOUNT_I1D
        KOUNT_I2D=>wrt_int_state%KOUNT_I2D
        KOUNT_R1D=>wrt_int_state%KOUNT_R1D
        KOUNT_R2D=>wrt_int_state%KOUNT_R2D
        KOUNT_LOG=>wrt_int_state%KOUNT_LOG
        LENGTH_DATA_I1D=>wrt_int_state%LENGTH_DATA_I1D
        LENGTH_DATA_R1D=>wrt_int_state%LENGTH_DATA_R1D
        LENGTH_DATA_R2D=>wrt_int_state%LENGTH_DATA_R2D
        LENGTH_SUM_I1D=>wrt_int_state%LENGTH_SUM_I1D
        LENGTH_SUM_R1D=>wrt_int_state%LENGTH_SUM_R1D
        LENGTH_SUM_R2D=>wrt_int_state%LENGTH_SUM_R2D
        LENGTH_SUM_LOG=>wrt_int_state%LENGTH_SUM_LOG
        NCOUNT_FIELDS=>wrt_int_state%NCOUNT_FIELDS
        ALL_DATA_I1D=>wrt_int_state%ALL_DATA_I1D
        ALL_DATA_R1D=>wrt_int_state%ALL_DATA_R1D
        FIELD_NAME=>wrt_int_state%FIELD_NAME
        NAMES_I1D_STRING=>wrt_int_state%NAMES_I1D_STRING
        NAMES_I2D_STRING=>wrt_int_state%NAMES_I2D_STRING
        NAMES_R1D_STRING=>wrt_int_state%NAMES_R1D_STRING
        NAMES_R2D_STRING=>wrt_int_state%NAMES_R2D_STRING
        NAMES_LOG_STRING=>wrt_int_state%NAMES_LOG_STRING
        ALL_DATA_LOG=>wrt_int_state%ALL_DATA_LOG
!
      ELSEIF(OUTPUT_FLAG=='Restart')THEN
!
        ALLOCATE(wrt_int_state%NUM_WORDS_SEND_I2D_RST)
        ALLOCATE(wrt_int_state%NUM_WORDS_SEND_R2D_RST)
!BSCCTM2
!        ALLOCATE(wrt_int_state%RST_FIELD_NAME(1:5000))
        ALLOCATE(wrt_int_state%RST_FIELD_NAME(1:30000))
!BSCCTM2
        ALLOCATE(wrt_int_state%RST_NAMES_I1D_STRING)
        ALLOCATE(wrt_int_state%RST_NAMES_I2D_STRING)
        ALLOCATE(wrt_int_state%RST_NAMES_R1D_STRING)
        ALLOCATE(wrt_int_state%RST_NAMES_R2D_STRING)
        ALLOCATE(wrt_int_state%RST_NAMES_LOG_STRING)
!
        NUM_WORDS_SEND_I2D=>wrt_int_state%NUM_WORDS_SEND_I2D_RST
        NUM_WORDS_SEND_R2D=>wrt_int_state%NUM_WORDS_SEND_R2D_RST
        KOUNT_I1D=>wrt_int_state%RST_KOUNT_I1D
        KOUNT_I2D=>wrt_int_state%RST_KOUNT_I2D
        KOUNT_R1D=>wrt_int_state%RST_KOUNT_R1D
        KOUNT_R2D=>wrt_int_state%RST_KOUNT_R2D
        KOUNT_LOG=>wrt_int_state%RST_KOUNT_LOG
        LENGTH_DATA_I1D=>wrt_int_state%RST_LENGTH_DATA_I1D
        LENGTH_DATA_R1D=>wrt_int_state%RST_LENGTH_DATA_R1D
        LENGTH_DATA_R2D=>wrt_int_state%RST_LENGTH_DATA_R2D
        LENGTH_SUM_I1D=>wrt_int_state%RST_LENGTH_SUM_I1D
        LENGTH_SUM_R1D=>wrt_int_state%RST_LENGTH_SUM_R1D
        LENGTH_SUM_R2D=>wrt_int_state%RST_LENGTH_SUM_R2D
        LENGTH_SUM_LOG=>wrt_int_state%RST_LENGTH_SUM_LOG
        NCOUNT_FIELDS=>wrt_int_state%RST_NCOUNT_FIELDS
        ALL_DATA_I1D=>wrt_int_state%RST_ALL_DATA_I1D
        ALL_DATA_R1D=>wrt_int_state%RST_ALL_DATA_R1D
        FIELD_NAME=>wrt_int_state%RST_FIELD_NAME
        NAMES_I1D_STRING=>wrt_int_state%RST_NAMES_I1D_STRING
        NAMES_I2D_STRING=>wrt_int_state%RST_NAMES_I2D_STRING
        NAMES_R1D_STRING=>wrt_int_state%RST_NAMES_R1D_STRING
        NAMES_R2D_STRING=>wrt_int_state%RST_NAMES_R2D_STRING
        NAMES_LOG_STRING=>wrt_int_state%RST_NAMES_LOG_STRING
        ALL_DATA_LOG=>wrt_int_state%RST_ALL_DATA_LOG
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE POINT_LOCAL
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
      SUBROUTINE FILL_GROUP_STATES
!
!-----------------------------------------------------------------------
!
      IF(OUTPUT_FLAG=='History')THEN
!
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_I2D_HST)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_R2D_HST)
!BSCCTM2
!        ALLOCATE(wrt_int_state_x(N)%loc_int_state%FIELD_NAME(1:5000))
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%FIELD_NAME(1:30000))
!BSCCTM2
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NAMES_I1D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NAMES_I2D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NAMES_R1D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NAMES_R2D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NAMES_LOG_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%ALL_DATA_I2D(wrt_int_state%NUM_WORDS_SEND_I2D_HST),stat=ISTAT)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%ALL_DATA_R2D(wrt_int_state%NUM_WORDS_SEND_R2D_HST),stat=ISTAT)
!
        wrt_int_state_x(N)%loc_int_state%INPES=wrt_int_state%INPES
        wrt_int_state_x(N)%loc_int_state%JNPES=wrt_int_state%JNPES
        wrt_int_state_x(N)%loc_int_state%IHALO=wrt_int_state%IHALO
        wrt_int_state_x(N)%loc_int_state%JHALO=wrt_int_state%JHALO
        wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_I2D_HST=wrt_int_state%NUM_WORDS_SEND_I2D_HST
        wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_R2D_HST=wrt_int_state%NUM_WORDS_SEND_R2D_HST
        wrt_int_state_x(N)%loc_int_state%KOUNT_I1D=wrt_int_state%KOUNT_I1D
        wrt_int_state_x(N)%loc_int_state%KOUNT_I2D=wrt_int_state%KOUNT_I2D
        wrt_int_state_x(N)%loc_int_state%KOUNT_R1D=wrt_int_state%KOUNT_R1D
        wrt_int_state_x(N)%loc_int_state%KOUNT_R2D=wrt_int_state%KOUNT_R2D
        wrt_int_state_x(N)%loc_int_state%KOUNT_LOG=wrt_int_state%KOUNT_LOG
        wrt_int_state_x(N)%loc_int_state%LENGTH_DATA_I1D=wrt_int_state%LENGTH_DATA_I1D
        wrt_int_state_x(N)%loc_int_state%LENGTH_DATA_R1D=wrt_int_state%LENGTH_DATA_R1D
!       wrt_int_state_x(N)%loc_int_state%LENGTH_DATA_R2D=wrt_int_state%LENGTH_DATA_R2D
        wrt_int_state_x(N)%loc_int_state%LENGTH_SUM_I1D=wrt_int_state%LENGTH_SUM_I1D
        wrt_int_state_x(N)%loc_int_state%LENGTH_SUM_R1D=wrt_int_state%LENGTH_SUM_R1D
!       wrt_int_state_x(N)%loc_int_state%LENGTH_SUM_R2D=wrt_int_state%LENGTH_SUM_R2D
        wrt_int_state_x(N)%loc_int_state%LENGTH_SUM_LOG=wrt_int_state%LENGTH_SUM_LOG
        wrt_int_state_x(N)%loc_int_state%NCOUNT_FIELDS=wrt_int_state%NCOUNT_FIELDS
        wrt_int_state_x(N)%loc_int_state%ALL_DATA_I1D=wrt_int_state%ALL_DATA_I1D
        wrt_int_state_x(N)%loc_int_state%ALL_DATA_R1D=wrt_int_state%ALL_DATA_R1D
        wrt_int_state_x(N)%loc_int_state%FIELD_NAME=wrt_int_state%FIELD_NAME
        wrt_int_state_x(N)%loc_int_state%NAMES_I1D_STRING=wrt_int_state%NAMES_I1D_STRING
        wrt_int_state_x(N)%loc_int_state%NAMES_I2D_STRING=wrt_int_state%NAMES_I2D_STRING
        wrt_int_state_x(N)%loc_int_state%NAMES_R1D_STRING=wrt_int_state%NAMES_R1D_STRING
        wrt_int_state_x(N)%loc_int_state%NAMES_R2D_STRING=wrt_int_state%NAMES_R2D_STRING
        wrt_int_state_x(N)%loc_int_state%NAMES_LOG_STRING=wrt_int_state%NAMES_LOG_STRING
        wrt_int_state_x(N)%loc_int_state%ALL_DATA_LOG=wrt_int_state%ALL_DATA_LOG
!
        DO NN=0,LAST_FCST_TASK
          wrt_int_state_x(N)%loc_int_state%LOCAL_ISTART(NN)=wrt_int_state%LOCAL_ISTART(NN)
          wrt_int_state_x(N)%loc_int_state%LOCAL_IEND(NN)=wrt_int_state%LOCAL_IEND(NN)
          wrt_int_state_x(N)%loc_int_state%LOCAL_JSTART(NN)=wrt_int_state%LOCAL_JSTART(NN)
          wrt_int_state_x(N)%loc_int_state%LOCAL_JEND(NN)=wrt_int_state%LOCAL_JEND(NN)
        ENDDO
!
      ELSEIF(OUTPUT_FLAG=='Restart')THEN
!
        wrt_int_state_x(N)%loc_int_state%INPES=wrt_int_state%INPES
        wrt_int_state_x(N)%loc_int_state%JNPES=wrt_int_state%JNPES
        wrt_int_state_x(N)%loc_int_state%IHALO=wrt_int_state%IHALO
        wrt_int_state_x(N)%loc_int_state%JHALO=wrt_int_state%JHALO
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_I2D_RST)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_R2D_RST)
!BSCCTM2
!        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_FIELD_NAME(1:5000))
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_FIELD_NAME(1:30000))
!BSCCTM2
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_NAMES_I1D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_NAMES_I2D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_NAMES_R1D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_NAMES_R2D_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_NAMES_LOG_STRING)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_ALL_DATA_I2D(wrt_int_state%NUM_WORDS_SEND_I2D_RST),stat=ISTAT)
        ALLOCATE(wrt_int_state_x(N)%loc_int_state%RST_ALL_DATA_R2D(wrt_int_state%NUM_WORDS_SEND_R2D_RST),stat=ISTAT)
!
        wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_I2D_RST=wrt_int_state%NUM_WORDS_SEND_I2D_RST
        wrt_int_state_x(N)%loc_int_state%NUM_WORDS_SEND_R2D_RST=wrt_int_state%NUM_WORDS_SEND_R2D_RST
        wrt_int_state_x(N)%loc_int_state%RST_KOUNT_I1D=wrt_int_state%RST_KOUNT_I1D
        wrt_int_state_x(N)%loc_int_state%RST_KOUNT_I2D=wrt_int_state%RST_KOUNT_I2D
        wrt_int_state_x(N)%loc_int_state%RST_KOUNT_R1D=wrt_int_state%RST_KOUNT_R1D
        wrt_int_state_x(N)%loc_int_state%RST_KOUNT_R2D=wrt_int_state%RST_KOUNT_R2D
        wrt_int_state_x(N)%loc_int_state%RST_KOUNT_LOG=wrt_int_state%RST_KOUNT_LOG
        wrt_int_state_x(N)%loc_int_state%RST_LENGTH_DATA_I1D=wrt_int_state%RST_LENGTH_DATA_I1D
        wrt_int_state_x(N)%loc_int_state%RST_LENGTH_DATA_R1D=wrt_int_state%RST_LENGTH_DATA_R1D
!       wrt_int_state_x(N)%loc_int_state%RST_LENGTH_DATA_R2D=wrt_int_state%RST_LENGTH_DATA_R2D
        wrt_int_state_x(N)%loc_int_state%RST_LENGTH_SUM_I1D=wrt_int_state%RST_LENGTH_SUM_I1D
        wrt_int_state_x(N)%loc_int_state%RST_LENGTH_SUM_R1D=wrt_int_state%RST_LENGTH_SUM_R1D
!       wrt_int_state_x(N)%loc_int_state%RST_LENGTH_SUM_R2D=wrt_int_state%RST_LENGTH_SUM_R2D
        wrt_int_state_x(N)%loc_int_state%RST_LENGTH_SUM_LOG=wrt_int_state%RST_LENGTH_SUM_LOG
        wrt_int_state_x(N)%loc_int_state%RST_NCOUNT_FIELDS=wrt_int_state%RST_NCOUNT_FIELDS
        wrt_int_state_x(N)%loc_int_state%RST_ALL_DATA_I1D=wrt_int_state%RST_ALL_DATA_I1D
        wrt_int_state_x(N)%loc_int_state%RST_ALL_DATA_R1D=wrt_int_state%RST_ALL_DATA_R1D
        wrt_int_state_x(N)%loc_int_state%RST_FIELD_NAME=wrt_int_state%RST_FIELD_NAME
        wrt_int_state_x(N)%loc_int_state%RST_NAMES_I1D_STRING=wrt_int_state%RST_NAMES_I1D_STRING
        wrt_int_state_x(N)%loc_int_state%RST_NAMES_I2D_STRING=wrt_int_state%RST_NAMES_I2D_STRING
        wrt_int_state_x(N)%loc_int_state%RST_NAMES_R1D_STRING=wrt_int_state%RST_NAMES_R1D_STRING
        wrt_int_state_x(N)%loc_int_state%RST_NAMES_R2D_STRING=wrt_int_state%RST_NAMES_R2D_STRING
        wrt_int_state_x(N)%loc_int_state%RST_NAMES_LOG_STRING=wrt_int_state%RST_NAMES_LOG_STRING
        wrt_int_state_x(N)%loc_int_state%RST_ALL_DATA_LOG=wrt_int_state%RST_ALL_DATA_LOG
!
        DO NN=0,LAST_FCST_TASK
          wrt_int_state_x(N)%loc_int_state%LOCAL_ISTART(NN)=wrt_int_state%LOCAL_ISTART(NN)
          wrt_int_state_x(N)%loc_int_state%LOCAL_IEND(NN)=wrt_int_state%LOCAL_IEND(NN)
          wrt_int_state_x(N)%loc_int_state%LOCAL_JSTART(NN)=wrt_int_state%LOCAL_JSTART(NN)
          wrt_int_state_x(N)%loc_int_state%LOCAL_JEND(NN)=wrt_int_state%LOCAL_JEND(NN)
        ENDDO
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE FILL_GROUP_STATES
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE PRELIM_INFO_FOR_OUTPUT
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE OPEN_HST_FILE(WRT_INT_STATE,FILENAME)
!
!-----------------------------------------------------------------------
!***  Open a history disk file.
!-----------------------------------------------------------------------
!
!      INCLUDE 'netcdf.inc'
!
!-----------------------
!*** Argument variables
!-----------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE            !<-- The I/O component's internal state
!
      CHARACTER(ESMF_MAXSTR),INTENT(OUT) :: FILENAME
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER :: FRAC_SEC,INT_SEC,N,RC,STAT
!
      LOGICAL :: OPENED
!
!      CHARACTER(ESMF_MAXSTR) :: FILENAME
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Specifying 'DEFERRED' as the filename in the configure file
!***  means that we want to construct the output filename from
!***  HST_NAME_BASE (from the config file) appended with the
!***  forecast hour.
!-----------------------------------------------------------------------
!
      INT_SEC=INT(wrt_int_state%NFSECONDS)
      FRAC_SEC=NINT((wrt_int_state%NFSECONDS-INT_SEC)*100.)
!
      IF(wrt_int_state%WRITE_HST_BIN.OR.                              &
           wrt_int_state%WRITE_HST_NEMSIO)THEN
!
      WRITE(FILENAME,100)TRIM(wrt_int_state%HST_NAME_BASE)//'_bin_'     &
                        ,wrt_int_state%NFHOURS,'h_'                     &
                        ,wrt_int_state%NFMINUTES,'m_'                   &
                        ,INT_SEC,'.',FRAC_SEC,'s'
  100 FORMAT(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A)
!
      ELSEIF(wrt_int_state%WRITE_HST_NETCDF)THEN
!
      WRITE(FILENAME,132)TRIM(wrt_int_state%HST_NAME_BASE)//'_nc4_'     &
                        ,wrt_int_state%NFHOURS,'h_'                     &
                        ,wrt_int_state%NFMINUTES,'m_'                   &
                        ,INT_SEC,'.',FRAC_SEC,'s.nc'
  132 FORMAT(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A)
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Find an unopened unit number if one was not designated in
!***  the configure file.
!-----------------------------------------------------------------------
!
      DO N=51,99
        INQUIRE(N,opened=OPENED)
        IF(.NOT.OPENED)THEN
          wrt_int_state%IO_HST_UNIT=N
          EXIT
        ENDIF
      ENDDO
!
!-----------------------------------------------------------------------
!***  Open the file now.
!-----------------------------------------------------------------------
!
      IF(wrt_int_state%WRITE_HST_BIN.OR.                              &
           wrt_int_state%WRITE_HST_NEMSIO)THEN
!
      OPEN(unit  =wrt_int_state%IO_HST_UNIT                             &
          ,file  =FILENAME                                              &
          ,status='REPLACE'                                             &
          ,access='SEQUENTIAL'                                          &
          ,form  ='UNFORMATTED'                                         &
          ,iostat=RC)
!
      IF(RC==0)THEN
        IF(wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) THEN
          WRITE(0,*)' Opened IO_HST_UNIT=',wrt_int_state%IO_HST_UNIT,' for history'
          write(0,*)' iostat=',rc,' file=',trim(filename)
        ENDIF
      ELSE
        WRITE(0,*)' Failed to OPEN IO_HST_UNIT=',wrt_int_state%IO_HST_UNIT,' for history'
      ENDIF
!
      ENDIF
!
      IF(wrt_int_state%WRITE_HST_NETCDF)THEN
!
        STAT = NF90_CREATE(FILENAME, OR(NF90_CLOBBER,NF90_NETCDF4), wrt_int_state%IO_HST_UNIT) 
!
        IF(STAT.NE.NF90_NOERR) WRITE(0,*) 'The following error has ocurred while nf_create_hst_file'//nf90_strerror(stat)
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE OPEN_HST_FILE
!
!-----------------------------------------------------------------------
!#######################################################################
!
!-----------------------------------------------------------------------
!
      SUBROUTINE OPEN_RST_FILE(WRT_INT_STATE)
!
!-----------------------------------------------------------------------
!***  Open a restart disk file.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE            !<-- The I/O component's internal state
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER :: FRAC_SEC,INT_SEC,N,RC
!
      LOGICAL :: OPENED
!
      CHARACTER(ESMF_MAXSTR) :: FILENAME
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Specifying 'DEFERRED' as the filename in the configure file
!***  means that we want to construct the output filename from
!***  RST_NAME_BASE (from the config file) appended with the
!***  forecast hour.
!-----------------------------------------------------------------------
!
      INT_SEC=INT(wrt_int_state%NFSECONDS)
      FRAC_SEC=NINT((wrt_int_state%NFSECONDS-INT_SEC)*100.)
      WRITE(FILENAME,100)TRIM(wrt_int_state%RST_NAME_BASE)//'_bin_'     &
                        ,wrt_int_state%NFHOURS,'h_'                     &
                        ,wrt_int_state%NFMINUTES,'m_'                   &
                        ,INT_SEC,'.',FRAC_SEC,'s'
  100 FORMAT(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A)
!
!-----------------------------------------------------------------------
!***  Find an unopened unit number if one was not designated in
!***  the configure file.
!-----------------------------------------------------------------------
!
      DO N=51,99
        INQUIRE(N,opened=OPENED)
        IF(.NOT.OPENED)THEN
          wrt_int_state%IO_RST_UNIT=N
          EXIT
        ENDIF
      ENDDO
!
!-----------------------------------------------------------------------
!***  Open the file now.
!-----------------------------------------------------------------------
!
      OPEN(unit  =wrt_int_state%IO_RST_UNIT                             &
          ,file  =FILENAME                                              &
          ,status='REPLACE'                                             &
          ,access='SEQUENTIAL'                                          &
          ,form  ='UNFORMATTED'                                         &
          ,iostat=RC)
!
      IF(RC==0) THEN
        IF(wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) THEN
          WRITE(0,*)' Opened IO_RST_UNIT=',wrt_int_state%IO_RST_UNIT,' for restart'
          write(0,*)' iostat=',rc,' file=',trim(filename)
        ENDIF
      ELSE
        WRITE(0,*)' Failed to OPEN IO_RST_UNIT=',wrt_int_state%IO_RST_UNIT,' for restart'
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE OPEN_RST_FILE
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_INIT(DOMAIN_GRID_COMP                            &
                           ,DOMAIN_INT_STATE                            &
                           ,DOMAIN_IMP_STATE                            &
                           ,CLOCK_DOMAIN                                &
                           ,MYPE)
! 
!-----------------------------------------------------------------------
!***  Execute the Initialize step of the Write components.
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      TYPE(ESMF_GridComp),INTENT(INOUT)         :: DOMAIN_GRID_COMP        !<-- The DOMAIN component
!
      TYPE(DOMAIN_INTERNAL_STATE),INTENT(INOUT) :: DOMAIN_INT_STATE        !<-- The DOMAIN Internal State
!
      TYPE(ESMF_State),INTENT(INOUT)            :: DOMAIN_IMP_STATE        !<-- The DOMAIN import state
!
      TYPE(ESMF_Clock),INTENT(INOUT)            :: CLOCK_DOMAIN            !<-- The DOMAIN Component's ESMF Clock
!
      INTEGER,INTENT(IN)                        :: MYPE
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER(kind=KINT) :: I,INPES,J,JNPES,LEAD_TASK,NUM_PES_FCST
!
      INTEGER(kind=KINT) :: RC,RC_INIT
!
      TYPE(ESMF_Config) :: CF                                              !<-- The config object
!
      TYPE(ESMF_VM) :: VM                                                  !<-- The ESMF virtual machine.
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Retrieve the config object CF from the DOMAIN component.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Get Config Object from DOMAIN Component in Write Init"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_GridCompGet(gridcomp=DOMAIN_GRID_COMP                   &  !<-- The DOMAIN component
                           ,config  =CF                                 &  !<-- The config object (~namelist)
                           ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  How many forecast tasks do we have?
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Write Init: Get INPES from Config File"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &  !<-- The ESMF configure object
                                  ,value =INPES                         &  !<-- # of fcst tasks in I direction
                                  ,label ='inpes:'                      &  !<-- Give the value of this label to INPES
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Write Init: Get JNPES from Config File"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &  !<-- The ESMF configure object
                                  ,value =JNPES                         &  !<-- # of fcst tasks in J direction
                                  ,label ='jnpes:'                      &  !<-- Give the value of this label to JNPES
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      NUM_PES_FCST=INPES*JNPES                                             !<-- Total number of forecast tasks
!
!-----------------------------------------------------------------------
!***  Transfer the rank of the lead task on each domain into the
!***  Write component import states since that component needs
!***  this information.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Write Init: Extract Lead Task on Domain from Domain Import"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(state=DOMAIN_IMP_STATE                   &  !<-- The Domain component's import state
                              ,name ='Lead Task Domain'                 &  !<-- Name of the Attribute to extract
                              ,value=LEAD_TASK                          &  !<-- Global rank of lead task on this domain
                              ,defaultValue=0                           &  !<-- The default value
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Write Init: Insert Lead Task into Write Import State"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeSet(state=domain_int_state%IMP_STATE_WRITE   &  !<-- The Write component's import state
                              ,name ='Lead Task Domain'                 &  !<-- Name of the Attribute to extract
                              ,value=LEAD_TASK                          &  !<-- Global rank of lead task on this domain
                              ,rc   =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
       CALL ERR_MSG(RC,MESSAGE_CHECK,RC_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  Execute the Initialize step for the Write components.
!***  These are the Initialize subroutines specified in the
!***  register routines called in ESMF_GridCompSetServices.
!-----------------------------------------------------------------------
!
      DO J=1,domain_int_state%WRITE_GROUPS
!
!!!!    CALL ESMF_VMBarrier(VM,rc=RC)    ! Insert barrier since fcst tasks are involved in each iteration of write groups
!
        DO I=1,NUM_PES_FCST+domain_int_state%WRITE_TASKS_PER_GROUP
          IF(MYPE==domain_int_state%PETLIST_WRITE(I,J))THEN                !<--  Forecast tasks plus the Write tasks in each write group
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            MESSAGE_CHECK="Execute Initialize Step of Write Component"
!           CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
            CALL ESMF_GridCompInitialize(gridcomp   =domain_int_state%WRITE_COMPS(J)   &  !<-- The Write gridded components
                                        ,importState=domain_int_state%IMP_STATE_WRITE  &  !<-- The Write import state
                                        ,exportState=domain_int_state%EXP_STATE_WRITE  &  !<-- The Write export state
                                        ,clock      =CLOCK_DOMAIN                      &  !<-- The ESMF clock of the DOMAIN component
                                        ,rc         =RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
            CALL ERR_MSG(RC,MESSAGE_CHECK,RC_INIT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          ENDIF
        ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!***  Some aspects of the output data do not change with forecast time
!***  for both the forecast and the quilt tasks.  Determine all such
!***  information now and save it.  Do this work once for history
!***  and once for restart output.
!-----------------------------------------------------------------------
!
      CALL PRELIM_INFO_FOR_OUTPUT('History'                             &
                                 ,NUM_PES_FCST                          &
                                 ,domain_int_state%WRITE_GROUPS         &
                                 ,domain_int_state%WRITE_COMPS          &
                                 ,domain_int_state%IMP_STATE_WRITE )
!
      CALL PRELIM_INFO_FOR_OUTPUT('Restart'                             &
                                 ,NUM_PES_FCST                          &
                                 ,domain_int_state%WRITE_GROUPS         &
                                 ,domain_int_state%WRITE_COMPS          &
                                 ,domain_int_state%IMP_STATE_WRITE )
!
!-----------------------------------------------------------------------
!***  Set the first Write group as the first one to act.
!-----------------------------------------------------------------------
!
      domain_int_state%WRITE_GROUP_READY_TO_GO=1
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_INIT
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE SEND_UPDATED_ATTRIBUTES(OUTPUT_BUNDLE                  &
                                        ,ALL_DATA_INT_ATT               &
                                        ,ALL_DATA_REAL_ATT              &
                                        ,ALL_DATA_LOG_ATT               &
                                        ,LENGTH_INT_DATA                &
                                        ,LENGTH_REAL_DATA               &
                                        ,LENGTH_LOG_DATA                &
                                        ,MAX_GROUPS                     &
                                        ,WRITE_GROUP                    &
                                        ,INTERCOMM )
!
!-----------------------------------------------------------------------
!***  The lead forecast task sends the updated ESMF Attributes in
!***  the input Bundle to the lead quilt task.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      INTEGER(kind=KINT),INTENT(IN) :: INTERCOMM                        &  !<-- Intercommunicator between fcst/quilt tasks
                                      ,LENGTH_INT_DATA                  &  !<-- Length of integer Attribute datastring
                                      ,LENGTH_LOG_DATA                  &  !<-- Length of logical Attribute datastring
                                      ,LENGTH_REAL_DATA                 &  !<-- Length of real Attribute datastring
                                      ,MAX_GROUPS                       &  !<-- Max # of Write groups
                                      ,WRITE_GROUP                         !<-- The current Write group
!
      INTEGER(kind=KINT),DIMENSION(1:LENGTH_INT_DATA),INTENT(OUT) ::    &
                                                       ALL_DATA_INT_ATT    !<-- The integer Attributes in the output Bundle
!
      REAL(kind=KFPT),DIMENSION(1:LENGTH_REAL_DATA),INTENT(OUT) ::      &
                                                       ALL_DATA_REAL_ATT   !<-- The real Attributes in the output Bundle
!
      LOGICAL(kind=KLOG),DIMENSION(1:LENGTH_LOG_DATA),INTENT(OUT) ::    &
                                                       ALL_DATA_LOG_ATT    !<-- The logical Attributes in the output Bundle
!
      TYPE(ESMF_FieldBundle),INTENT(INOUT) :: OUTPUT_BUNDLE                !<-- The ESMF output data Bundle (history/restart)
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER(kind=KINT) :: KOUNT_INT_ATT,KOUNT_LOG_ATT,KOUNT_REAL_ATT  &
                           ,L,LENGTH,LENGTH_SUM_INT_ATT                 &
                           ,LENGTH_SUM_LOG_ATT,LENGTH_SUM_REAL_ATT      &
                           ,N,NUM_ATTRIB
!
      INTEGER(kind=KINT) :: IERR,RC,RC_ATT
!
      INTEGER(kind=KINT),DIMENSION(MPI_STATUS_SIZE) :: JSTAT
!
      INTEGER(kind=KINT),DIMENSION(:),ALLOCATABLE :: WORK_ARRAY_INT_ATT
!
      INTEGER(kind=KINT),DIMENSION(:),POINTER :: HANDLE_INT_ATT         &
                                                ,HANDLE_LOG_ATT         &
                                                ,HANDLE_REAL_ATT
!
      INTEGER(kind=KINT),DIMENSION(:),ALLOCATABLE,TARGET,SAVE ::        &
                                                    HANDLE_INT_ATT_HST  &
                                                   ,HANDLE_INT_ATT_RST  &
                                                   ,HANDLE_LOG_ATT_HST  &
                                                   ,HANDLE_LOG_ATT_RST  &
                                                   ,HANDLE_REAL_ATT_HST &
                                                   ,HANDLE_REAL_ATT_RST
!
      REAL(kind=KFPT),DIMENSION(:),ALLOCATABLE :: WORK_ARRAY_REAL_ATT
!
      LOGICAL(kind=KLOG) :: WORK_LOGICAL
!
      CHARACTER(len=14) :: BUNDLE_NAME
!
      CHARACTER(ESMF_MAXSTR) :: ATTRIB_NAME
!
      TYPE(ESMF_TypeKind_Flag) :: DATATYPE
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Get Name of the Output Bundle"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_FieldBundleGet(FIELDBUNDLE   =OUTPUT_BUNDLE             &
                              ,name          =BUNDLE_NAME               &
                              ,rc            =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ATT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="Get Attribute Count from Output Bundle"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE                  &  !<-- The write component's history data Bundle
                            ,count      =NUM_ATTRIB                     &  !<-- # of Attributes in the history data Bundle
                            ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ATT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      KOUNT_INT_ATT=0                                                      !<-- Initialize counter of integer Attributes
      KOUNT_REAL_ATT=0                                                     !<-- Initialize counter of real Attributes
      KOUNT_LOG_ATT=0                                                      !<-- Initialize counter of logical Attributes
!
      LENGTH_SUM_INT_ATT=0                                                 !<-- Initialize length of the integer Attribute datastring
      LENGTH_SUM_REAL_ATT=0                                                !<-- Initialize length of the real Attribute datastring
      LENGTH_SUM_LOG_ATT=0                                                 !<-- Initialize length of the logical Attribute datastring
!
!-----------------------------------------------------------------------
!***  Allocate the ISend handles if not done already.
!-----------------------------------------------------------------------
!
      IF(BUNDLE_NAME=='History Bundle')THEN
!
        IF(.NOT.ALLOCATED(HANDLE_INT_ATT_HST))THEN
!
          ALLOCATE(HANDLE_INT_ATT_HST(1:MAX_GROUPS))
          ALLOCATE(HANDLE_REAL_ATT_HST(1:MAX_GROUPS))
          ALLOCATE(HANDLE_LOG_ATT_HST(1:MAX_GROUPS))
!
          DO N=1,MAX_GROUPS
            HANDLE_INT_ATT_HST(N)=MPI_REQUEST_NULL
            HANDLE_REAL_ATT_HST(N)=MPI_REQUEST_NULL
            HANDLE_LOG_ATT_HST(N)=MPI_REQUEST_NULL
          ENDDO
!
        ENDIF
!
        HANDLE_INT_ATT=>HANDLE_INT_ATT_HST
        HANDLE_REAL_ATT=>HANDLE_REAL_ATT_HST
        HANDLE_LOG_ATT=>HANDLE_LOG_ATT_HST
!
      ELSEIF(BUNDLE_NAME=='Restart Bundle')THEN
!
        IF(.NOT.ALLOCATED(HANDLE_INT_ATT_RST))THEN
!
          ALLOCATE(HANDLE_INT_ATT_RST(1:MAX_GROUPS))
          ALLOCATE(HANDLE_REAL_ATT_RST(1:MAX_GROUPS))
          ALLOCATE(HANDLE_LOG_ATT_RST(1:MAX_GROUPS))
!
          DO N=1,MAX_GROUPS
            HANDLE_INT_ATT_RST(N)=MPI_REQUEST_NULL
            HANDLE_REAL_ATT_RST(N)=MPI_REQUEST_NULL
            HANDLE_LOG_ATT_RST(N)=MPI_REQUEST_NULL
          ENDDO
!
        ENDIF
!
        HANDLE_INT_ATT=>HANDLE_INT_ATT_RST
        HANDLE_REAL_ATT=>HANDLE_REAL_ATT_RST
        HANDLE_LOG_ATT=>HANDLE_LOG_ATT_RST
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      attrib_loop: DO N=1,NUM_ATTRIB
!
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        MESSAGE_CHECK="Get Attribute Names, Datatypes, and Lengths"
!       CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
        CALL ESMF_AttributeGet(FIELDBUNDLE   =OUTPUT_BUNDLE             &  !<-- The history data Bundle
                              ,attributeIndex=N                         &  !<-- Index of each Attribute
                              ,name          =ATTRIB_NAME               &  !<-- Each Attribute's name
                              ,typekind      =DATATYPE                  &  !<-- Each Attribute's ESMF Datatype
                              ,itemCount     =LENGTH                    &  !<-- Each Attribute's length
                              ,rc            =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
        CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ATT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!                 -- Scalar and 1-D Integer Output Data --
!-----------------------------------------------------------------------
!
        IF(DATATYPE==ESMF_TYPEKIND_I4)THEN                                 !<-- Extract integer data with rank <2
!
          ALLOCATE(WORK_ARRAY_INT_ATT(LENGTH),stat=RC)                     !<-- Allocate array to hold integer Attribute N
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Scalar/1-D Integer Data from Output Bundle"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE              &  !<-- The history data Bundle
                                ,name       =ATTRIB_NAME                &  !<-- Name of the Attribute to extract
                                ,itemCount  =LENGTH                     &  !<-- Length of Attribute
                                ,valueList  =WORK_ARRAY_INT_ATT         &  !<-- Place the Attribute here
                                ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ATT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          KOUNT_INT_ATT=KOUNT_INT_ATT+1                                    !<-- Count # of integer Attributes
!
          DO L=1,LENGTH
            ALL_DATA_INT_ATT(LENGTH_SUM_INT_ATT+L)=WORK_ARRAY_INT_ATT(L)   !<-- String together the integer Attributes
          ENDDO
!
          LENGTH_SUM_INT_ATT=LENGTH_SUM_INT_ATT+LENGTH                     !<-- Total word sum of integer Attributesd
          DEALLOCATE(WORK_ARRAY_INT_ATT)
!
!-----------------------------------------------------------------------
!                 -- Scalar and 1-D Real Output Data --
!-----------------------------------------------------------------------
!
        ELSEIF(DATATYPE==ESMF_TYPEKIND_R4)THEN                             !<-- Extract real data with rank <2
!
          ALLOCATE(WORK_ARRAY_REAL_ATT(LENGTH),stat=RC)                   !<-- Allocate array to hold real Attribute N
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Scalar/1-D Real Data from Output Bundle"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE            &  !<-- The history data Bundle
                                ,name       =ATTRIB_NAME              &  !<-- Name of the Attribute to extract
                                ,itemCount  =LENGTH                   &  !<-- Length of Attribute
                                ,valueList  =WORK_ARRAY_REAL_ATT      &  !<-- Place the Attribute here
                                ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ATT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          KOUNT_REAL_ATT=KOUNT_REAL_ATT+1                                 !<-- Count # of real Attributes
!
          DO L=1,LENGTH
            ALL_DATA_REAL_ATT(LENGTH_SUM_REAL_ATT+L)=WORK_ARRAY_REAL_ATT(L) !<-- String together the real Attributes
          ENDDO
!
          LENGTH_SUM_REAL_ATT=LENGTH_SUM_REAL_ATT+LENGTH                  !<-- Total word sum of real Attributes
          DEALLOCATE(WORK_ARRAY_REAL_ATT)
!
!-----------------------------------------------------------------------
!                       -- Logical Output Data --
!-----------------------------------------------------------------------
!
!!!     ELSEIF(DATATYPE==ESMF_TYPEKIND_LOGICAL)THEN                       !<-- Extract logical data
        ELSE                                                              !<-- Extract logical data
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          MESSAGE_CHECK="Get Scalar/1-D Logical Data from Output Bundle"
!         CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          CALL ESMF_AttributeGet(FIELDBUNDLE=OUTPUT_BUNDLE            &  !<-- The history data Bundle
                                ,name       =ATTRIB_NAME              &  !<-- Name of the Attribute to extract
                                ,value      =WORK_LOGICAL             &  !<-- Place the Attribute here
                                ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ATT)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          KOUNT_LOG_ATT=KOUNT_LOG_ATT+1                                   !<-- Count # of logical Attributes
!
          ALL_DATA_LOG_ATT(LENGTH_SUM_LOG_ATT+1)=WORK_LOGICAL             !<-- String together the logical Attributes
!
          LENGTH_SUM_LOG_ATT=LENGTH_SUM_LOG_ATT+1                         !<-- Total word sum of logical Attributes
!
!-----------------------------------------------------------------------
!
        ENDIF
!
!-----------------------------------------------------------------------
!
      ENDDO attrib_loop
!
!-----------------------------------------------------------------------
!***  Lead fcst task sends the integer Attributes to the lead
!***  quilt task.
!-----------------------------------------------------------------------
!
      IF(LENGTH_SUM_INT_ATT>0)THEN
!
        CALL MPI_WAIT(HANDLE_INT_ATT(WRITE_GROUP),JSTAT,IERR)
!
        CALL MPI_ISSEND(ALL_DATA_INT_ATT                                &  !<-- String of integer Attribute output data
                       ,LENGTH_SUM_INT_ATT                              &  !<-- # of words in the data string
                       ,MPI_INTEGER                                     &  !<-- The datatype
                       ,0                                               &  !<-- Send to the lead Write task in the group
                       ,WRITE_GROUP                                     &  !<-- Use the Write group as the tag
                       ,INTERCOMM                                       &  !<-- The MPI intercommunicator between fcst and quilt tasks
                       ,HANDLE_INT_ATT(WRITE_GROUP)                     &  !<-- MPI communication request handle
                       ,IERR )
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Lead fcst task sends the real Attributes to the lead quilt task.
!-----------------------------------------------------------------------
!
      IF(LENGTH_SUM_REAL_ATT>0)THEN
!
        CALL MPI_WAIT(HANDLE_REAL_ATT(WRITE_GROUP),JSTAT,IERR)
!
        CALL MPI_ISSEND(ALL_DATA_REAL_ATT                               &  !<-- String of real Attribute output data
                       ,LENGTH_SUM_REAL_ATT                             &  !<-- # of words in the data string
                       ,MPI_REAL                                        &  !<-- The datatype
                       ,0                                               &  !<-- Send to the lead Write task in the group
                       ,WRITE_GROUP                                     &  !<-- Use the Write group as the tag
                       ,INTERCOMM                                       &  !<-- The MPI intercommunicator between fcst and quilt tasks
                       ,HANDLE_REAL_ATT(WRITE_GROUP)                    &  !<-- MPI communication request handle
                       ,IERR )
!
      ENDIF
!
!-----------------------------------------------------------------------
!***  Lead fcst task sends the logical Attributes to the 
!***  lead quilt task.
!-----------------------------------------------------------------------
!
      IF(LENGTH_SUM_LOG_ATT>0)THEN
!
        CALL MPI_WAIT(HANDLE_LOG_ATT(WRITE_GROUP),JSTAT,IERR)
!
        CALL MPI_ISSEND(ALL_DATA_LOG_ATT                                &  !<-- String of logical Attribute output data
                       ,LENGTH_SUM_LOG_ATT                              &  !<-- # of words in the data string
                       ,MPI_LOGICAL                                     &  !<-- The datatype
                       ,0                                               &  !<-- Send to the lead Write task in the group
                       ,WRITE_GROUP                                     &  !<-- Use the Write group as the tag
                       ,INTERCOMM                                       &  !<-- The MPI intercommunicator between fcst and quilt tasks
                       ,HANDLE_LOG_ATT(WRITE_GROUP)                     &  !<-- MPI communication request handle
                       ,IERR )
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE SEND_UPDATED_ATTRIBUTES
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_ASYNC(DOMAIN_GRID_COMP                           &
                            ,DOMAIN_INT_STATE                           &
                            ,CLOCK_DOMAIN                               &
                            ,MYPE                                       &
                            ,CWRT)
!
!-----------------------------------------------------------------------
!***  Write out a history file using the asynchronous quilting.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(ESMF_GridComp),INTENT(INOUT) :: DOMAIN_GRID_COMP               !<-- The DOMAIN component
!
      TYPE(DOMAIN_INTERNAL_STATE),INTENT(INOUT) :: DOMAIN_INT_STATE       !<-- The DOMAIN Internal State
!
      TYPE(ESMF_Clock),INTENT(INOUT) :: CLOCK_DOMAIN                      !<-- The DOMAIN Component's ESMF Clock
!
      CHARACTER(ESMF_MAXSTR),INTENT(IN) :: CWRT                           !<-- Restart/History label
!
!---------------------
!***  Local Variables
!---------------------
!
      TYPE(ESMF_Config) :: CF                                             !<-- The configure object (~namelist)
!
      TYPE(ESMF_Time)   :: CURRTIME                                       !<-- The current forecast time (ESMF)
!
      INTEGER,INTENT(IN) :: MYPE
!
      INTEGER :: YY,MM,DD,H,M,S                                           !<-- Year, Month, Day, Hour, Minute, Second (integer)
!
      INTEGER :: I,INPES,JNPES,N_GROUP,NUM_PES_FCST                     &
                ,WRITE_GROUPS,WRITE_TASKS_PER_GROUP                     &
                ,RC,RC_ASYNC
!
      LOGICAL :: PRINT_OUTPUT, PRINT_ALL                                  !<-- Prints to err file flags
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Check whether this is history or restart call.
!-----------------------------------------------------------------------
!
      IF(CWRT=='History') TIME_FOR_HISTORY = .TRUE.
      IF(CWRT=='Restart') TIME_FOR_RESTART = .TRUE.
!     write(0,*)' enter WRITE_ASYNC time_for_history=',time_for_history,' time_for_restart=',time_for_restart
!
!-----------------------------------------------------------------------
!***  Extract the configure object in order to know the number
!***  of forecast tasks, Write groups, and write tasks per group.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="WRITE_ASYNC: Extract Config Object from DOMAIN Component"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_GridCompGet(gridcomp=DOMAIN_GRID_COMP                   &  !<-- The DOMAIN component
                           ,config  =CF                                 &  !<-- The config object (~namelist)
                           ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ASYNC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="WRITE_ASYNC: Get General Info from Config File"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &
                                  ,value =INPES                         &  !<-- # of fcst tasks in I direction
                                  ,label ='inpes:'                      &
                                  ,rc    =RC)
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &
                                  ,value =JNPES                         &  !<-- # of fcst tasks in J direction
                                  ,label ='jnpes:'                      &
                                  ,rc    =RC)
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &  !<-- The configure file
                                  ,value =WRITE_GROUPS                  &  !<-- Number of write groups
                                  ,label ='write_groups:'               &
                                  ,rc    =RC)
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &  !<-- The configure file
                                  ,value =WRITE_TASKS_PER_GROUP         &  !<-- Number of write tasks per group
                                  ,label ='write_tasks_per_group:'      &
                                  ,rc    =RC)
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &  !<-- The configure file
                                  ,value =PRINT_OUTPUT                  &  !<-- Print output flag
                                  ,label ='print_output:'               &
                                  ,rc    =RC)
!
      CALL ESMF_ConfigGetAttribute(config=CF                            &  !<-- The configure file
                                  ,value =PRINT_ALL                     &  !<-- Print output flag
                                  ,label ='print_all:'                  &
                                  ,rc    =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ASYNC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      NUM_PES_FCST=INPES*JNPES                                             !<-- Number of forecast tasks
!
!-----------------------------------------------------------------------
!***  What is the current forecast time?
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="WRITE_ASYNC: Get Current Time from DOMAIN Clock"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_ClockGet(clock   =CLOCK_DOMAIN                          &  !<-- The DOMAIN component's ESMF Clock
                        ,currTime=CURRTIME                              &  !<-- The current forecast time (ESMF)
                        ,rc      =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ASYNC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="WRITE_ASYNC: Convert ESMF Time to Real Time"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_TimeGet (time=CURRTIME                                  &  !<-- The current forecast time (ESMF)
                        ,yy  =YY                                        &  !<-- The current year (integer)
                        ,mm  =MM                                        &  !<-- The current month (integer)
                        ,dd  =DD                                        &  !<-- The current day (integer)
                        ,h   =H                                         &  !<-- The current hour (integer)
                        ,m   =M                                         &  !<-- The current minute (integer)
                        ,s   =S                                         &  !<-- The current second (integer)
                        ,rc  =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ASYNC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!-----------------------------------------------------------------------
!***  The export state of the SOLVER component lies within the
!***  internal state of the DOMAIN component and holds the
!***  import state of the Write component.
!***  Extract that Write component's import state since we are 
!***  about to execute the Run step of the Write component.
!-----------------------------------------------------------------------
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="WRITE_ASYNC: Extract Write Import State from Dyn Export State"
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      CALL ESMF_StateGet(state      =domain_int_state%EXP_STATE_SOLVER  &  !<-- The Solver component's export state
                        ,itemName   ="Write Import State"               &  !<-- Name of state to be extracted
                        ,nestedState=domain_int_state%IMP_STATE_WRITE   &  !<-- The extracted state
                        ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ASYNC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
!!!   CALL ESMF_VMBarrier(vm=VM,rc=RC)
!
!-----------------------------------------------------------------------
!***  All forecast tasks plus those write tasks in the appropriate
!***  Write group execute the Run step of a Write component.
!-----------------------------------------------------------------------
!
      N_GROUP=domain_int_state%WRITE_GROUP_READY_TO_GO                       !<-- The active write group
!     write(0,*)' WRITE_ASYNC calling WRITE_RUN for write group ',n_group &
!              ,' num_pes_fcst=',num_pes_fcst,' write_tasks_per_group=',write_tasks_per_group
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
      MESSAGE_CHECK="WRITE_ASYNC: Execute Run Step of Write Components" 
!     CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
      DO I=1,NUM_PES_FCST+WRITE_TASKS_PER_GROUP
        IF(MYPE==domain_int_state%PETLIST_WRITE(I,N_GROUP))THEN
          CALL ESMF_GridCompRun(gridcomp=domain_int_state%WRITE_COMPS(N_GROUP) &  !<-- The write gridded component
                               ,importState=domain_int_state%IMP_STATE_WRITE   &  !<-- Its import state
                               ,exportState=domain_int_state%EXP_STATE_WRITE   &  !<-- Its export state
                               ,clock      =CLOCK_DOMAIN                       &  !<-- The DOMAIN Clock
                               ,rc         =RC)
!
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
          CALL ERR_MSG(RC,MESSAGE_CHECK,RC_ASYNC)
! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!
          IF(I==NUM_PES_FCST+1)THEN                                          !<-- The first write task tells us the history output time
            IF(PRINT_OUTPUT .OR. PRINT_ALL) &
            WRITE(0,101)TRIM(CWRT),YY,MM,DD,H,M,S
  101       FORMAT(' Wrote ',A7,' File at ',I4.4,'_',I2.2,'_',I2.2,'_',I2.2,':',I2.2,':',I2.2)
          ENDIF
!
        ENDIF
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Prepare to use the next write group at the next output time.
!***  Return to the 1st group if we have cycled through all of them.
!-----------------------------------------------------------------------
!
      IF(domain_int_state%WRITE_GROUP_READY_TO_GO==WRITE_GROUPS)THEN
        domain_int_state%WRITE_GROUP_READY_TO_GO=1
      ELSE
        domain_int_state%WRITE_GROUP_READY_TO_GO=domain_int_state%WRITE_GROUP_READY_TO_GO+1
      ENDIF
!
!-----------------------------------------------------------------------
!***  Restore TIME_FOR_HISTORY and TIME_FOR_RESTART to false.
!-----------------------------------------------------------------------
!
      TIME_FOR_HISTORY = .FALSE.
      TIME_FOR_RESTART = .FALSE.
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_ASYNC
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_RUNHISTORY_OPEN(WRT_INT_STATE                    &
                                      ,IYEAR_FCST                       &
                                      ,IMONTH_FCST                      &
                                      ,IDAY_FCST                        &
                                      ,IHOUR_FCST                       &
                                      ,IMINUTE_FCST                     &
                                      ,SECOND_FCST                      &
                                      ,NF_HOURS                         &
                                      ,NF_MINUTES                       &
                                      ,NF_SECONDS                       &
                                      ,HST_FIRST                        &
                                      ,LEAD_WRITE_TASK )
!
!-----------------------------------------------------------------------
!***  Write out a binary run history file.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE            !<-- The Write component's internal state
!
      INTEGER,INTENT(IN) :: IYEAR_FCST                                  &
                           ,IMONTH_FCST                                 &
                           ,IDAY_FCST                                   &
                           ,IHOUR_FCST                                  &
                           ,IMINUTE_FCST                                &
                           ,NF_HOURS                                    &
                           ,NF_MINUTES                                  &
                           ,LEAD_WRITE_TASK
!
      REAL,INTENT(IN) :: NF_SECONDS,SECOND_FCST
!
      LOGICAL,INTENT(IN) :: HST_FIRST
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER :: N,N1,N2,NPOSN_1,NPOSN_2,LENGTH
      INTEGER :: NFIELD,RC
      CHARACTER(ESMF_MAXSTR)                :: NAME
      INTEGER,DIMENSION(:),POINTER          :: WORK_ARRAY_I1D
      REAL(4),DIMENSION(:),POINTER          :: WORK_ARRAY_R1D
      LOGICAL                               :: WRITE_LOGICAL
      LOGICAL                               :: WORK_LOGICAL
      CHARACTER(ESMF_MAXSTR) :: FILENAME

!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Open the history file and write the current forecast time
!***  and elapsed time.
!-----------------------------------------------------------------------
!
      CALL OPEN_HST_FILE(WRT_INT_STATE,FILENAME)
!
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IYEAR_FCST
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IMONTH_FCST
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IDAY_FCST
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IHOUR_FCST
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IMINUTE_FCST
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)SECOND_FCST
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)NF_HOURS
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)NF_MINUTES
      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)NF_SECONDS
!
      IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
        WRITE(0,*)' Wrote IYEAR_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote IMONTH_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote IDAY_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote IHOUR_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote IMINUTE_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote SECOND_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote NF_HOURS to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote NF_MINUTES to history file unit ',wrt_int_state%IO_HST_UNIT
        WRITE(0,*)' Wrote NF_SECONDS to history file unit ',wrt_int_state%IO_HST_UNIT
      ENDIF
!
!-----------------------------------------------------------------------
!***  Integer scalar/1-D history variables
!-----------------------------------------------------------------------
!
      N2=0                                                                !<-- Word counter for full string of integer scalar/1D data
!
      DO N=1,wrt_int_state%KOUNT_I1D(1)                                   !<-- Loop through all scalar/1D integer data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_I1D_STRING(NPOSN_1:NPOSN_2)              !<-- The variable's name
        LENGTH=wrt_int_state%LENGTH_DATA_I1D(N)                           !<-- The variable's length in words
        ALLOCATE(WORK_ARRAY_I1D(LENGTH),stat=RC)
!
        DO N1=1,LENGTH
          N2=N2+1
          WORK_ARRAY_I1D(N1)=wrt_int_state%ALL_DATA_I1D(N2)               !<-- Extract the individual data from the data string
        ENDDO
!
        WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)WORK_ARRAY_I1D          !<-- Write out the data
!
        IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
          WRITE(0,*)'Wrote ',TRIM(NAME),' to history file unit ',wrt_int_state%IO_HST_UNIT
        ENDIF
!
        DEALLOCATE(WORK_ARRAY_I1D)
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Real scalar/1-D history variables
!-----------------------------------------------------------------------
!
      N2=0                                                                !<-- Word counter for full string of real scalar/1D data
!
      DO N=1,wrt_int_state%KOUNT_R1D(1)                                   !<-- Loop through all scalar/1D real data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_R1D_STRING(NPOSN_1:NPOSN_2)              !<-- The variable's name
        LENGTH=wrt_int_state%LENGTH_DATA_R1D(N)                           !<-- The variable's length
        ALLOCATE(WORK_ARRAY_R1D(LENGTH),stat=RC)
!
        DO N1=1,LENGTH
          N2=N2+1
          WORK_ARRAY_R1D(N1)=wrt_int_state%ALL_DATA_R1D(N2)               !<-- Extract the individual data from the data string
        ENDDO
!
        WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)WORK_ARRAY_R1D          !<-- Write out the data
!
        IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
          WRITE(0,*)'Wrote ',TRIM(NAME),' to history file unit ',wrt_int_state%IO_HST_UNIT
        ENDIF
!
        DEALLOCATE(WORK_ARRAY_R1D)
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Logical history variables
!-----------------------------------------------------------------------
!
      N2=0                                                                !<-- Counter for full string of logical data
!
      DO N=1,wrt_int_state%KOUNT_LOG(1)                                   !<-- Loop through all logical data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_LOG_STRING(NPOSN_1:NPOSN_2)              !<-- The variable's name
!
        N2=N2+1

        WORK_LOGICAL = wrt_int_state%ALL_DATA_LOG(N2)
        WRITE_LOGICAL=WORK_LOGICAL                                        !<-- Convert from ESMF_Logical to F90 logical
!
        WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)WRITE_LOGICAL           !<-- Write out the data
!
        IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
          WRITE(0,*)'Wrote ',TRIM(NAME),' to history file unit ',wrt_int_state%IO_HST_UNIT
        ENDIF
!
      ENDDO
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_RUNHISTORY_OPEN
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_NEMSIO_RUNHISTORY_OPEN(WRT_INT_STATE             &
                                             ,NEMSIOFILE                &
                                             ,IYEAR_FCST                &
                                             ,IMONTH_FCST               &
                                             ,IDAY_FCST                 &
                                             ,IHOUR_FCST                &
                                             ,IMINUTE_FCST              &
                                             ,SECOND_FCST               &
                                             ,NF_HOURS                  &
                                             ,NF_MINUTES                &
                                             ,NF_SECONDS                &
                                             ,DIM1,DIM2,NFRAME,GLOBAL   &
                                             ,LEAD_WRITE_TASK           &
                                             ,ID_DOMAIN)
!
!-----------------------------------------------------------------------
!***  Write out a NEMSIO binary run history file.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE             !<-- The Write component's internal state
!
      TYPE(NEMSIO_GFILE),INTENT(INOUT)         :: NEMSIOFILE                !<-- The nemsio file handler
!
      INTEGER,INTENT(IN)  :: IYEAR_FCST                                 &
                            ,IMONTH_FCST                                &
                            ,IDAY_FCST                                  &
                            ,IHOUR_FCST                                 &
                            ,IMINUTE_FCST                               &
                            ,ID_DOMAIN                                  &
                            ,NF_HOURS                                   &
                            ,NF_MINUTES                                 &
                            ,LEAD_WRITE_TASK

      INTEGER,INTENT(OUT) :: DIM1,DIM2,NFRAME
      LOGICAL,INTENT(OUT) :: GLOBAL
!
      REAL,INTENT(IN)     :: NF_SECONDS                                 &
                            ,SECOND_FCST
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER :: I,J,N,N1,N2,NPOSN_1,NPOSN_2,LENGTH,MAXLENGTH
!
      INTEGER :: FIELDSIZE,IM,JM,LM,IDATE(7),FCSTDATE(7)                &
                ,INDX_2D,IRET,IND1,IND2,IND3,IND4,CNT                   &
 		,INI1,INI2,INI3                                         &
                ,N2ISCALAR,N2IARY,N2RSCALAR,N2RARY,N2LSCALAR            &
                ,NMETA,NSOIL,TLMETA,VLEV
!
      INTEGER :: FRAC_SEC,INT_SEC,NFIELD,RC
!
      INTEGER,DIMENSION(:),POINTER :: ARYILEN                           &
                                     ,ARYRLEN                           &
                                     ,RECLEV                            &
                                     ,VARIVAL
!
      INTEGER,DIMENSION(:,:),POINTER :: ARYIVAL
!
      REAL(4) :: DEGRAD,DXCTL,DYCTL,TPH0D,TLM0D
!
      REAL(4),DIMENSION(:),POINTER :: DX,DY,DXH                         &
                                     ,GLAT1D,GLON1D
!
      REAL(4),DIMENSION(:,:,:),POINTER :: VCOORD
!
      REAL(KIND=KFPT),DIMENSION(:)  ,POINTER :: VARRVAL
      REAL(KIND=KFPT),DIMENSION(:,:),POINTER :: ARYRVAL
!
      LOGICAL,DIMENSION(:),POINTER :: VARLVAL
!
      CHARACTER(6)  :: MODEL_LEVEL
      CHARACTER(16) :: VLEVTYP,FILE_ENDIAN
!
      CHARACTER(16),DIMENSION(:),POINTER :: ARYINAME                    &
                                           ,ARYRNAME                    &
                                           ,RECNAME                     &
                                           ,VARINAME                    &
                                           ,VARRNAME                    &
                                           ,VARLNAME
!
      CHARACTER(16),DIMENSION(:),POINTER :: RECLEVTYP
!
      CHARACTER(ESMF_MAXSTR) :: NAME,FILENAME
!
      LOGICAL            :: WORK_LOGICAL
!
      INTEGER :: NDYH=0,NDXH=0,NPT=0,NPDTOP=0,NREC=0                    &
                ,NSG1=0,NSG2=0,NSGML1=0,NSGML2=0
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      FCSTDATE(1)=IYEAR_FCST
      FCSTDATE(2)=IMONTH_FCST
      FCSTDATE(3)=IDAY_FCST
      FCSTDATE(4)=IHOUR_FCST
      FCSTDATE(5)=IMINUTE_FCST
      FCSTDATE(6)=NINT(SECOND_FCST*100.)
      FCSTDATE(7)=100
!
!-----------------------------------------------------------------------
!***  Integer scalar/1-D history variables
!-----------------------------------------------------------------------
!
!-------------------------------------------------------------
!*** Find out the total number of int scalars and int arrays.
!-------------------------------------------------------------
!
      N2ISCALAR=0
      N2IARY=0
      MAXLENGTH=1
!
      DO N=1,wrt_int_state%KOUNT_I1D(1)                                    !<-- Loop through all scalar/1D integer data
        LENGTH=wrt_int_state%LENGTH_DATA_I1D(N)
!
        IF(LENGTH==1)THEN
          N2ISCALAR=N2ISCALAR+1
        ELSE
          N2IARY=N2IARY+1
          MAXLENGTH=MAX(LENGTH,MAXLENGTH)
        ENDIF
!
      ENDDO
!
      N2IARY=N2IARY+1
      MAXLENGTH=MAX(MAXLENGTH,7)
      ALLOCATE(VARINAME(N2ISCALAR),VARIVAL(N2ISCALAR))
      ALLOCATE(ARYINAME(N2IARY),ARYILEN(N2IARY),ARYIVAL(MAXLENGTH,N2IARY))
!
!---------------------------------------
!***  Set value to AVRIVAL and ARYIVAL.
!---------------------------------------
!
      N2=0                                                                 !<-- Word counter for full string of integer scalar/1D data
      N2ISCALAR=0
      N2IARY=0
      IDATE=0
!
      DO N=1,wrt_int_state%KOUNT_I1D(1)                                    !<-- Loop through all scalar/1D integer data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_I1D_STRING(NPOSN_1:NPOSN_2)               !<-- The variable's name
        LENGTH=wrt_int_state%LENGTH_DATA_I1D(N)                            !<-- The variable's length in words
!
        IF(LENGTH==1)THEN
          N2=N2+1
          N2ISCALAR=N2ISCALAR+1
          VARINAME(N2ISCALAR)=TRIM(NAME)
          VARIVAL(N2ISCALAR)=wrt_int_state%ALL_DATA_I1D(N2)
          IF(VARINAME(N2ISCALAR)=='IHRST') then
            IDATE(4)=VARIVAL(N2ISCALAR)
          ENDIF
        ELSE
          N2IARY=N2IARY+1
          ARYINAME(N2IARY)=TRIM(NAME)
          ARYILEN(N2IARY)=LENGTH
!            write(0,*)'in I1D array,aryiname=',aryiname(N2IARY),'len=',aryilen(N2IARY),  &
!              wrt_int_state%ALL_DATA_I1D(N2+1:N2+length)
!
          DO N1=1,LENGTH
            N2=N2+1
            ARYIVAL(N1,N2IARY)=wrt_int_state%ALL_DATA_I1D(N2)              !<-- Extract the individual data from the data string
          ENDDO

          IF(ARYINAME(N2IARY)=='IDAT') THEN
            IDATE(1)=ARYIVAL(3,N2IARY)
            IDATE(2)=ARYIVAL(2,N2IARY)
            IDATE(3)=ARYIVAL(1,N2IARY)
            IDATE(7)=100.
          ENDIF
!
!           write(0,*)'in I1D array,aryival=',aryival(:,N2IARY)
        ENDIF
!
      ENDDO
!
!-----------------------------
!***  Add fcst_date into ARYI
!-----------------------------
!
      N2IARY=N2IARY+1
      ARYINAME(N2IARY)='FCSTDATE'
      ARYILEN(N2IARY)=7
      ARYIVAL(1:7,N2IARY)=FCSTDATE(1:7)
!
!-----------------------------------------------------------------------
!***  Real scalar/1-D history variables
!-----------------------------------------------------------------------
!
!------------------------------------------------------------
!***  Find the total number of real scalars and real arrays.
!------------------------------------------------------------
!
      N2RSCALAR=0
      N2RARY=0
      MAXLENGTH=1
!
      DO N=1,wrt_int_state%KOUNT_R1D(1)                                    !<-- Loop through all scalar/1D real data
        LENGTH=wrt_int_state%LENGTH_DATA_R1D(N)                            !<-- The variable's length
        IF(LENGTH==1)THEN
           N2RSCALAR=N2RSCALAR+1
        ELSE
          N2RARY=N2RARY+1
          MAXLENGTH=MAX(LENGTH,MAXLENGTH)
        ENDIF
      ENDDO
!
      ALLOCATE(VARRNAME(N2RSCALAR),VARRVAL(N2RSCALAR))
      ALLOCATE(ARYRNAME(N2RARY),ARYRLEN(N2RARY),ARYRVAL(MAXLENGTH,N2RARY))
!
!------------------------------------------------------
!***  Set values for the real scalars and real arrays.
!------------------------------------------------------
      N2=0                                                                 !<-- Word counter for full string of real scalar/1D data
      N2RSCALAR=0
      N2RARY=0
!
      DO N=1,wrt_int_state%KOUNT_R1D(1)                                    !<-- Loop through all scalar/1D real data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_R1D_STRING(NPOSN_1:NPOSN_2)               !<-- The variable's name
        LENGTH=wrt_int_state%LENGTH_DATA_R1D(N)                            !<-- The variable's length
!
        IF(LENGTH==1)THEN
          N2=N2+1
          N2RSCALAR=N2RSCALAR+1
          VARRNAME(N2RSCALAR)=TRIM(NAME)
          VARRVAL(N2RSCALAR)=wrt_int_state%ALL_DATA_R1D(N2)
!
          IF( TRIM(NAME)=='PT') THEN
            NPT=N2RSCALAR
          ELSEIF ( TRIM(NAME)=='PDTOP') THEN
            NPDTOP=N2RSCALAR
          ELSEIF ( TRIM(NAME)=='DYH') THEN
            NDYH=N2RSCALAR
          ELSEIF ( TRIM(NAME)=='TPH0D') THEN
            TPH0D=VARRVAL(N2RSCALAR)
          ELSEIF ( trim(NAME)=='TLM0D') THEN
            TLM0D=VARRVAL(N2RSCALAR)
          ENDIF
!
        ELSE
          N2RARY=N2RARY+1
          ARYRNAME(N2RARY)=TRIM(NAME)
          ARYRLEN(N2RARY)=LENGTH
!
          DO N1=1,LENGTH
            N2=N2+1
            ARYRVAL(N1,N2RARY)=wrt_int_state%ALL_DATA_R1D(N2)              !<-- Extract the individual data from the data string
          ENDDO
!
          IF( TRIM(NAME)=='SG1') THEN
            NSG1=N2RARY
          ELSEIF ( TRIM(NAME)=='SG2') THEN
            NSG2=N2RARY
          ELSEIF ( TRIM(NAME)=='SGML1' ) THEN
            NSGML1=N2RARY
          ELSEIF (TRIM(NAME)=='SGML2') THEN
            NSGML2=N2RARY
          ELSEIF (TRIM(NAME)=='DXH') THEN
            NDXH=N2RARY
          ENDIF

        ENDIF
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Logical history variables
!-----------------------------------------------------------------------
!
      N2LSCALAR=wrt_int_state%KOUNT_LOG(1)                                 !<-- Counter for full string of logical data
!
      ALLOCATE(VARLNAME(N2LSCALAR),VARLVAL(N2LSCALAR))
      N2LSCALAR=0
!
      DO N=1,wrt_int_state%KOUNT_LOG(1)                                    !<-- Loop through all logical data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_LOG_STRING(NPOSN_1:NPOSN_2)               !<-- The variable's name
!
        N2LSCALAR=N2LSCALAR+1
        WORK_LOGICAL = wrt_int_state%ALL_DATA_LOG(N2LSCALAR)

        VARLNAME(N2LSCALAR)=NAME

        VARLVAL(N2LSCALAR)=wrt_int_state%ALL_DATA_LOG(N2LSCALAR)

        IF(TRIM(NAME)=='GLOBAL') GLOBAL=WORK_LOGICAL
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Now open NEMSIO file.
!-----------------------------------------------------------------------
!
      N=LEN_TRIM(wrt_int_state%HST_NAME_BASE)
      INT_SEC=INT(wrt_int_state%NFSECONDS)
      FRAC_SEC=NINT((wrt_int_state%NFSECONDS-INT_SEC)*100.)
      WRITE(FILENAME,100)wrt_int_state%HST_NAME_BASE(1:N)//'_nio_'      &
                        ,wrt_int_state%NFHOURS,'h_'                     &
                        ,wrt_int_state%NFMINUTES,'m_'                   &
                        ,INT_SEC,'.',FRAC_SEC,'s'
      IF(wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL)       &
      write(0,*)'FILENAME=',trim(FILENAME),'n=',n
  100 FORMAT(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A)
!
!----------------------------------------------------
!***  Prepare variables needed by the nemsip header:
!----------------------------------------------------
!
!dimension
      IF(GLOBAL) THEN
!for global im/jm for data field
        NFRAME=1
      ELSE
!for regional
        NFRAME=0
      ENDIF
      IM=wrt_int_state%im(1)
      JM=wrt_int_state%jm(1)
      DIM1=wrt_int_state%im(1)-2*NFRAME
      DIM2=wrt_int_state%jm(1)-2*NFRAME
!
      LM=wrt_int_state%LM(1)
!
!for nmmb whole domain
      FIELDSIZE=IM*JM
      NREC=wrt_int_state%kount_I2D(1)+wrt_int_state%kount_R2D(1)+1        !add fact10 for GSI
!
!vcoord
      ALLOCATE(VCOORD(LM+1,3,2))
      VCOORD=0.
      IF(NSG1>0.and.NSG2>0.and.NPDTOP>0.and.NPT>0) then
        VCOORD(1:LM+1,1,1)=0.1*(ARYRVAL(1:LM+1,NSG1)*VARRVAL(NPDTOP)      &
          -ARYRVAL(1:LM+1,NSG2)*(VARRVAL(NPDTOP)+VARRVAL(NPT))            &
          +VARRVAL(NPT) )
        VCOORD(1:LM+1,2,1)=ARYRVAL(1:LM+1,NSG2)
        VCOORD(1:LM+1,3,1)=0
      ENDIF
      IF(NSGML1>0.and.NSGML2>0.and.NPDTOP>0.and.NPT>0) then
        VCOORD(1:LM,1,2)=0.1*(ARYRVAL(1:LM,NSGML1)*VARRVAL(NPDTOP)        &
          -ARYRVAL(1:LM,NSGML2)*(VARRVAL(NPDTOP)+VARRVAL(NPT))            &
          +VARRVAL(NPT) )
        VCOORD(1:LM,2,2)=ARYRVAL(1:LM,NSGML2)
        VCOORD(1:LM,3,2)=0
      ENDIF
!!!   write(0,*)'after vcoord,count_I2d=',wrt_int_state%kount_I2D(1),'nrec=',nrec
!
!-----------------------------------------------------------------------
!***  Cut the output I2D array.
!-----------------------------------------------------------------------
!
      ALLOCATE(RECNAME(NREC),RECLEVTYP(NREC),RECLEV(NREC))
      NREC=0
      INI1=0                                                               !<-- # of 1 layer vars 
      INI2=0                                                               !<-- # of total layers of vars with lm layer
      INI3=0                                                               !<-- # of total layers of vars with lm+1 layer
!
      DO NFIELD=1,wrt_int_state%KOUNT_I2D(1)
!
        NREC=NREC+1
        NPOSN_1=(NFIELD-1)*ESMF_MAXSTR+1
        NPOSN_2=NFIELD*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_I2D_STRING(NPOSN_1:NPOSN_2)               !<-- The name of this 2D integer history quantity
        INDX_2D=index(NAME,"_2D")
!
        IF (INDX_2D > 0) THEN
          MODEL_LEVEL=NAME(INDX_2D-3:INDX_2D-1)
          RECLEV(NREC)=(ICHAR(MODEL_LEVEL(1:1))-48)*100+(ICHAR(MODEL_LEVEL(2:2))-48)*10+ICHAR(MODEL_LEVEL(3:3))-48
          RECNAME(NREC)=NAME(1:INDX_2D-5)
          RECLEVTYP(NREC)='mid_layer'
          IF (RECLEV(NREC)==LM+1) THEN 
            RECLEVTYP(NREC-LM:NREC)='layer'
            INI3=INI3+LM+1
            INI2=INI2-(LM+1)
          ENDIF
          INI2=INI2+1
        ELSE
          RECNAME(NREC)=TRIM(NAME)
          RECLEV(NREC)=1
          RECLEVTYP(NREC)='sfc'
          INI1=INI1+1
        ENDIF
!
        IF (RECNAME(NREC)=='ISLTYP') RECNAME(NREC)='sltyp'
        IF (RECNAME(NREC)=='IVGTYP') RECNAME(NREC)='vgtyp'
        IF (RECNAME(NREC)=='NCFRCV') RECNAME(NREC)='cfrcv'
        IF (RECNAME(NREC)=='NCFRST') RECNAME(NREC)='cfrst'
        CALL LOWERCASE(RECNAME(NREC))
      ENDDO
!
!!!   write(0,*)'after I2D,nrec=',nrec
!
!-----------------------------------------------------------------------
!*** Cut the output R2D array.
!-----------------------------------------------------------------------
!
      NSOIL=0
      IND1=0                                                               !<-- # of 1-layer vars
      IND2=0                                                               !<-- # of total layers for vars with lm layers 
      IND3=0                                                               !<-- # of total layers for vars with lm+1 layers
      IND4=0                                                               !<-- # of total layers for vars with nsoil layers
!
      DO NFIELD=1,wrt_int_state%KOUNT_R2D(1)
!
        NREC=NREC+1
        NPOSN_1=(NFIELD-1)*ESMF_MAXSTR+1
        NPOSN_2=NFIELD*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_R2D_STRING(NPOSN_1:NPOSN_2)  !<-- The name of this 2D integer history quantity
        INDX_2D=INDEX(NAME,"_2D")
!
        IF (INDX_2D > 0) THEN
          MODEL_LEVEL=NAME(INDX_2D-3:INDX_2D-1)
          RECLEV(NREC)=(ICHAR(MODEL_LEVEL(1:1))-48)*100+(ICHAR(MODEL_LEVEL(2:2))-48)*10+ICHAR(MODEL_LEVEL(3:3))-48
          RECNAME(NREC)=NAME(1:INDX_2D-5)
          RECLEVTYP(NREC)='mid layer'
          IF (RECNAME(NREC)=='SMC') NSOIL=NSOIL+1
          IF (RECNAME(NREC)=='W_TOT') RECNAME(NREC)='vvel'
          IF (RECNAME(NREC)=='CW') RECNAME(NREC)='clwmr'
          IF (RECNAME(NREC)=='U') RECNAME(NREC)='ugrd'
          IF (RECNAME(NREC)=='V') RECNAME(NREC)='vgrd'
          IF (RECNAME(NREC)=='T') RECNAME(NREC)='tmp'
          IF (RECNAME(NREC)=='Q') RECNAME(NREC)='spfh'
          IF (RECNAME(NREC)=='O3') RECNAME(NREC)='o3mr'
          IF (RECLEV(NREC)==LM+1) THEN
            RECLEVTYP(NREC-LM:NREC)='layer'
            IND3=IND3+LM+1
            IND2=IND2-(LM+1)
          ENDIF
          IF (RECNAME(NREC)=='PINT') THEN
          RECNAME(NREC)='pres'
          ELSE IF (RECNAME(NREC)=='SMC'.OR.RECNAME(NREC)=='SH2O'.or.RECNAME(NREC)=='STC') THEN 
             RECLEVTYP(NREC)='soil layer' 
             IND4=IND4+1
             IND2=IND2-1
          ENDIF
          IND2=IND2+1
        ELSE
          RECLEV(NREC)=1
          RECNAME(NREC)=TRIM(NAME)
          RECLEVTYP(NREC)='sfc'
!
          IF (INDEX(RECNAME(NREC),"10")>0) RECLEVTYP(NREC)='10 m above gnd'
          IF (RECNAME(NREC)=='PD') THEN
            RECNAME(NREC)='dpres'
            RECLEVTYP(NREC)='hybrid sig lev'
          ENDIF
!
          IF (RECNAME(NREC)=='SST') RECNAME(NREC)='tsea'
          IF (RECNAME(NREC)=='FIS') RECNAME(NREC)='hgt'
          IF (RECNAME(NREC)=='USTAR') RECNAME(NREC)='uustar'
          IF (RECNAME(NREC)=='Z0') RECNAME(NREC)='zorl'
          IND1=IND1+1
        ENDIF
!
        CALL LOWERCASE(RECNAME(NREC))
      ENDDO
!
!for fact10
      NREC=NREC+1
      RECNAME(NREC)='fact10'
      RECLEVTYP(NREC)='10 m above gnd'
      RECLEV(NREC)=1

!glat1d and glon1d
      ALLOCATE(GLAT1D(FIELDSIZE),GLON1D(FIELDSIZE))
      DEGRAD=90./ASIN(1.)
      glon1d=0.
      glat1d=0.
      NMETA=12
!
!dx and dy
      ALLOCATE(DX(FIELDSIZE),DY(FIELDSIZE))
!
      if(NDXH>0) then
       DO J=1,JM
       DO I=1,IM
         DX(I+(J-1)*IM)=ARYRVAL(J,NDXH)
       ENDDO
       ENDDO
!       write(0,*)'after dx=',maxval(dx),minval(dx)
      else
       NMETA=7
      endif
!
      if(NDYH>0) then
       DO I=1,FIELDSIZE
        DY(I)=VARRVAL(NDYH)
       ENDDO
!       write(0,*)'after dy=',maxval(dy),minval(dy)
      endif
!
!-----------------------------------------------------------------------
!                      SET UP NEMSIO WRITE
!-----------------------------------------------------------------------
!
      CALL NEMSIO_INIT(IRET=IRET)
!
!-----------------------------------------------------------------------
!***  Open NEMSIO run history file.
!-----------------------------------------------------------------------
!
      CALL NEMSIO_OPEN(NEMSIOFILE,trim(FILENAME),'write',iret,           &
        modelname="NMMB", gdatatype="bin4", idate=IDATE,nfhour=NF_HOURS, &
        nfminute=NF_MINUTES,nfsecondn=nint(NF_SECONDS*100),              &
        nfsecondd=100,dimx=DIM1,dimy=DIM2,dimz=LM,nframe=NFRAME,         &
        nmeta=NMETA,                                                     &
        nsoil=NSOIL,ntrac=3,nrec=nrec, ncldt=1,rlon_min=minval(glon1d),  &
        rlon_max=maxval(glon1d), rlat_max=maxval(glat1d),                &
        rlat_min=minval(glat1d),vcoord=vcoord,lon=glon1d,lat=glat1d,     &
        dx=dx,dy=dy,extrameta=.true.,nmetavari=N2ISCALAR,                &
        nmetavarr=N2RSCALAR,nmetavarl=N2LSCALAR,nmetaaryi=N2IARY,        &
        nmetaaryr=N2RARY,variname=VARINAME,varival=VARIVAL,              &
        varrname=VARRNAME,varrval=VARRVAL,varlname=VARLNAME,             &
        varlval=VARLVAL,aryiname=ARYINAME,aryilen=ARYILEN,               &
        aryival=ARYIVAL,aryrname=ARYRNAME,aryrlen=ARYRLEN,               &
        aryrval=ARYRVAL,recname=RECNAME,reclevtyp=RECLEVTYP,reclev=RECLEV)
!
!-----------------------------------------------------------------------
!***  Get variables needed by the .ctl file.
!-----------------------------------------------------------------------
!
      IF(wrt_int_state%WRITE_NEMSIOCTL.AND.wrt_int_state%MYPE==LEAD_WRITE_TASK)THEN
        CALL NEMSIO_GETFILEHEAD(NEMSIOFILE,TLMETA=TLMETA,FILE_ENDIAN=FILE_ENDIAN)
        DXCTL=MAXVAL(DX)*180./(A*PI)
        DYCTL=MAXVAL(DY)*180./(A*PI)
        CNT=INI1           & ! # of integer 1-layer fields
           +(INI2/LM)      & ! # of integer lm-layer fields
           +(INI3/(LM+1))  & ! # of integer lm+1-layer fields
           +IND1           & ! # of real 1-layer fields
           +(IND2/LM)      & ! # of real lm-layer fields
           +(IND3/(LM+1))  & ! # of real lm+1-layer fields
           +(IND4/NSOIL)   & ! # of real nsoil-layer fields
           +1                ! fact10
!
!-----------------------------------------------------------------------
!***  Write out NEMSIO ctl file.
!-----------------------------------------------------------------------
!
        CALL WRITE_NEMSIOCTL(GLOBAL,IHOUR_FCST,IDAY_FCST,IMONTH_FCST,   &
          IYEAR_FCST,FILENAME,TLMETA,IM,JM,LM,NSOIL,TLM0D,TPH0D,DXCTL,  &
          DYCTL,NF_HOURS,NREC,RECNAME,RECLEVTYP,CNT,FILE_ENDIAN,        &
          ID_DOMAIN)
      ENDIF
!
!-----------------------------------------------------------------------
!***  Clean up
!-----------------------------------------------------------------------
!
      DEALLOCATE(VCOORD,DX,DY)
      DEALLOCATE(VARINAME,VARIVAL,ARYINAME,ARYILEN,ARYIVAL)
      DEALLOCATE(VARRNAME,VARRVAL,ARYRNAME,ARYRLEN,ARYRVAL)
      DEALLOCATE(VARLNAME,VARLVAL)
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_NEMSIO_RUNHISTORY_OPEN
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_NETCDF_RUNHISTORY_OPEN(WRT_INT_STATE             &
                                      ,IYEAR_FCST                       &
                                      ,IMONTH_FCST                      &
                                      ,IDAY_FCST                        &
                                      ,IHOUR_FCST                       &
                                      ,IMINUTE_FCST                     &
                                      ,SECOND_FCST                      &
                                      ,NF_HOURS                         &
                                      ,NF_MINUTES                       &
                                      ,NF_SECONDS                       &
                                      ,HST_FIRST                        &
                                      ,tracers_name                     &
                                      ,LEAD_WRITE_TASK )
!
!-----------------------------------------------------------------------
!***  Write out a netcdf run history file.
!-----------------------------------------------------------------------
!
!      INCLUDE 'netcdf.inc'
!
!------------------------
!***  Argument variables
!------------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE            !<-- The Write component's internal state
!
      INTEGER,INTENT(IN) :: IYEAR_FCST                                  &
                           ,IMONTH_FCST                                 &
                           ,IDAY_FCST                                   &
                           ,IHOUR_FCST                                  &
                           ,IMINUTE_FCST                                &
                           ,NF_HOURS                                    &
                           ,NF_MINUTES                                  &
                           ,LEAD_WRITE_TASK
!
      REAL,INTENT(IN) :: NF_SECONDS,SECOND_FCST
!
      LOGICAL,INTENT(IN) :: HST_FIRST
!
      CHARACTER(20),INTENT(INOUT) :: tracers_name(200)
!
!---------------------
!***  Local variables
!---------------------
!
      INTEGER :: N,N1,N2,NPOSN_1,NPOSN_2,LENGTH,STAT,VARID
      INTEGER :: NFIELD,RC
      CHARACTER(ESMF_MAXSTR)                :: NAME
      INTEGER,DIMENSION(:),POINTER          :: WORK_ARRAY_I1D
      REAL(4),DIMENSION(:),POINTER          :: WORK_ARRAY_R1D
      LOGICAL                               :: WRITE_LOGICAL
      LOGICAL                               :: WORK_LOGICAL
!
      INTEGER :: position_aerosols
      CHARACTER(3) :: position_vector
      INTEGER :: file_id, time_dimid,i_dimid,j_dimid,lm_dimid,lmp_dimid,idat_dimid
!vobiso2018S
!      INTEGER :: cat_aero_dimid,num_aero_dimid,num_gas_total_dimid
      INTEGER :: cat_aero_dimid,num_aero_dimid,num_aero_r_dimid,num_aero_1_dimid,num_engy_dimid,num_gas_total_dimid
!vobiso2018E
      INTEGER :: time_varid,projection_id,rlon_id,rlat_id,lmm_dimid,soil_lm_dimid
      INTEGER :: lm_varid, lmp_varid
      INTEGER :: file_hist_id,i_hist_dimid,j_hist_dimid,lm_hist_dimid,soil_lm_hist_dimid
      CHARACTER(12) :: reg_grid_map
      CHARACTER(160) :: time_units
      INTEGER :: mid_val,i,j,id_domain,im,jm,lm,k
      INTEGER :: NUM_AERO,NUM_GAS_TOTAL
      INTEGER,DIMENSION(:),ALLOCATABLE :: lm_values, lmp_values
      real, dimension(:),allocatable        :: rlat_values, rlon_values
      real    :: lon_step,lat_step,tph0d,tlm0d,north_pole_lat,north_pole_lon
      LOGICAL :: GLOBAL
      integer,parameter :: imissing_value=-999999, ifill_value=-32767
      real,parameter :: missing_value=-999999., fill_value=-32767.0
      CHARACTER(ESMF_MAXSTR),SAVE :: FILENAME_FIRST_HOUR
      character(3) :: hist_time
      character(2) :: hist_dom

!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      ID_DOMAIN=wrt_int_state%ID_DOMAIN
      IF(ID_DOMAIN.EQ.1 .AND. wrt_int_state%GLOBAL_NC)THEN
        GLOBAL=.TRUE.
        IM=wrt_int_state%IM(1) !(ID_DOMAIN) !- 2
        JM=wrt_int_state%JM(1) !(ID_DOMAIN) !- 2
      ELSE
        GLOBAL=.FALSE.
        IM=wrt_int_state%IM(1) !( !ID_DOMAIN)
        JM=wrt_int_state%JM(1) !(ID_DOMAIN)
      ENDIF
      LM=wrt_int_state%LM(1) !(ID_DOMAIN)
      NUM_AERO = wrt_int_state%NUM_ASH                                 &
               + wrt_int_state%NUM_DUST                                &
               + wrt_int_state%NUM_SALT                                &
               + wrt_int_state%NUM_OM                                  &
               + wrt_int_state%NUM_BC                                  &
               + wrt_int_state%NUM_SO4                                 &
               + wrt_int_state%NUM_NO3                                 &
               + wrt_int_state%NUM_NH4                                 &
               + wrt_int_state%NUM_UNSPC                               &
               + wrt_int_state%NUM_AERO_UCI
! Names tracers meteo 1:7
      tracers_name(1:7) = (/'Q_tracers           ',&
                            'CW_tracers          ',&
                            'TKE_tracers         ',&
                            'QC                  ',&
                            'QR                  ',&
                            'QS                  ',&
                            'QG                  '/)
! Names tracers aerosols
      position_aerosols=1 
      if(wrt_int_state%NUM_ASH.GT.0)then
        do i=1,wrt_int_state%NUM_ASH
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_ash_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_DUST.GT.0)then
        do i=1,wrt_int_state%NUM_DUST
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_dust_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_SALT.GT.0)then
        do i=1,wrt_int_state%NUM_SALT
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_ssa_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_OM.GT.0)then
        do i=1,wrt_int_state%NUM_OM
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_om_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_BC.GT.0)then
        do i=1,wrt_int_state%NUM_BC
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_bc_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_SO4.GT.0)then
        do i=1,wrt_int_state%NUM_SO4
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_so4_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_NO3.GT.0)then
        do i=1,wrt_int_state%NUM_NO3
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_no3_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_NH4.GT.0)then
        do i=1,wrt_int_state%NUM_NH4
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_nh4_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      if(wrt_int_state%NUM_UNSPC.GT.0)then
        do i=1,wrt_int_state%NUM_UNSPC
          write(position_vector,'(I3.3)')i
          tracers_name(7+position_aerosols:7+position_aerosols) = 'aero_unsp_'//position_vector
          position_aerosols=position_aerosols+1
        enddo
      endif
!
      SELECT CASE (wrt_int_state%CHEM_MECH)
        CASE(0)
            NUM_GAS_TOTAL=0
        CASE(1)
            NUM_GAS_TOTAL=32
        CASE(2)
            NUM_GAS_TOTAL=53
        CASE(22)
            NUM_GAS_TOTAL=53
        CASE(3)
            NUM_GAS_TOTAL=73
        CASE(4)
            NUM_GAS_TOTAL=1
        CASE(5) 
            NUM_GAS_TOTAL=0
        CASE(6) 
            NUM_GAS_TOTAL=14
            tracers_name(7+position_aerosols:7+position_aerosols+NUM_GAS_TOTAL)= &
                     (/'SO2                 ',&
                       'DMS                 ',&
                       'H2O2                ',&
                       'A_PINENE            ',&
                       'ISOP                ',&
                       'P_ISOPP1G           ',&
                       'P_ISOPP2G           ',&
                       'P_APINP1G           ',&
                       'P_APINP2G           ',&
                       'P_TOL               ',&
                       'P_XYL               ',&
                       'P_O3                ',&
                       'P_OH                ',&
                       'P_HO2               '/)
        CASE(7)
            NUM_GAS_TOTAL=13
            tracers_name(7+position_aerosols:7+position_aerosols+NUM_GAS_TOTAL)= &
                     (/'SO2                 ',&
                       'DMS                 ',&
                       'H2O2                ',&
                       'A_PINENE            ',&
                       'ISOP                ',&
                       'VOCA                ',&
                       'VOCBB               ',&
                       'NH3                 ',&
                       'O3                  ',&
                       'OH                  ',&
                       'HO2                 ',&
                       'HNO3                ',&
                       'NO3                 '/)
        CASE(37)
            NUM_GAS_TOTAL=78
            tracers_name(7+position_aerosols:7+position_aerosols+NUM_GAS_TOTAL)=(/ &
                       'NO2                 ' &
                      ,'NO                  ' &
                      ,'O3                  ' &
                      ,'NO3                 ' &
                      ,'N2O5                ' &
                      ,'HNO3                ' &
                      ,'HONO                ' &
                      ,'PNA                 ' &
                      ,'H2O2                ' &
                      ,'NTR                 ' &
                      ,'ROOH                ' &
                      ,'FORM                ' &
                      ,'ALD2                ' &
                      ,'ALDX                ' &
                      ,'PAR                 ' &
                      ,'CO                  ' &
                      ,'MEPX                ' &
                      ,'MEOH                ' &
                      ,'FACD                ' &
                      ,'PAN                 ' &
                      ,'PACD                ' &
                      ,'AACD                ' &
                      ,'PANX                ' &
                      ,'OLE                 ' &
                      ,'ETH                 ' &
                      ,'IOLE                ' &
                      ,'TOL                 ' &
                      ,'CRES                ' &
                      ,'OPEN                ' &
                      ,'MGLY                ' &
                      ,'XYL                 ' &
                      ,'ISOP                ' &
                      ,'ISPD                ' &
                      ,'TERP                ' &
                      ,'SO2                 ' &
                      ,'SULF                ' &
                      ,'ETOH                ' &
                      ,'ETHA                ' &
                      ,'CL2                 ' &
                      ,'HOCL                ' &
                      ,'FMCL                ' &
                      ,'HCL                 ' &
                      ,'BENZENE             ' &
                      ,'SESQ                ' &
!NON-ADVECTED SPECIES
                      ,'O                   ' &
                      ,'O1D                 ' &
                      ,'OH                  ' &
                      ,'HO2                 ' &
                      ,'XO2                 ' &
                      ,'XO2N                ' &
                      ,'MEO2                ' &
                      ,'HCO3                ' &
                      ,'C2O3                ' &
                      ,'CXO3                ' &
                      ,'ROR                 ' &
                      ,'TO2                 ' &
                      ,'TOLRO2              ' &
                      ,'CRO                 ' &
                      ,'XYLRO2              ' &
                      ,'ISOPRXN             ' &
                      ,'TRPRXN              ' &
                      ,'SULRXN              ' &
                      ,'CL                  ' &
                      ,'CLO                 ' &
                      ,'TOLNRXN             ' &
                      ,'TOLHRXN             ' &
                      ,'XYLNRXN             ' &
                      ,'XYLHRXN             ' &
                      ,'BENZRO2             ' &
                      ,'BNZNRXN             ' &
                      ,'BNZHRXN             ' &
                      ,'SESQRXN             ' &
                      ,'NH3                 ' &
!FOR AEROSOL_BSC
                      ,'ISOPP1G             ' &
                      ,'ISOPP2G             ' &
                      ,'APINP1G             ' &
                      ,'APINP2G             ' &
                      ,'DMS                 '/)

      END SELECT
!
!-----------------------------------------------------------------------
!***  Open the history file and write the current forecast time
!***  and elapsed time.
!-----------------------------------------------------------------------
!
      IF(HST_FIRST)THEN
        CALL OPEN_HST_FILE(WRT_INT_STATE,FILENAME_FIRST_HOUR)
        wrt_int_state%WRITE_TIMESTEP=1
!
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IYEAR_FCST
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IMONTH_FCST
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IDAY_FCST
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IHOUR_FCST
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)IMINUTE_FCST
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)SECOND_FCST
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)NF_HOURS
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)NF_MINUTES
!      WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)NF_SECONDS
!
!      IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
!        WRITE(0,*)' Still not Wrote IYEAR_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote IMONTH_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote IDAY_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote IHOUR_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote IMINUTE_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote SECOND_FCST to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote NF_HOURS to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote NF_MINUTES to history file unit ',wrt_int_state%IO_HST_UNIT
!        WRITE(0,*)' Still not Wrote NF_SECONDS to history file unit ',wrt_int_state%IO_HST_UNIT
!      ENDIF
!
! Define dimensions netcdf
!
      file_id = wrt_int_state%IO_HST_UNIT
!
!      stat = nf90_def_dim( file_id, 'time', 1, time_dimid)
      stat = nf90_def_dim( file_id, 'time', NF90_UNLIMITED, time_dimid)
!
      IF (GLOBAL)THEN
        stat = nf90_def_dim( file_id, 'lon', IM, i_dimid)
        stat = nf90_def_dim( file_id, 'lat', JM, j_dimid)
      ELSE
        stat = nf90_def_dim( file_id, 'rlon', IM, i_dimid)
        stat = nf90_def_dim( file_id, 'rlat', JM, j_dimid)
      ENDIF
!
      stat = nf90_def_dim( file_id, 'lm', LM, lm_dimid)
      stat = nf90_def_dim( file_id, 'lmp', LM + 1, lmp_dimid)
      stat = nf90_def_dim( file_id, 'lmm', LM - 1, lmm_dimid)
      stat = nf90_def_dim( file_id, 'soil_lm', 4, soil_lm_dimid)
!
      stat = nf90_def_dim( file_id, 'idat', 3, idat_dimid)
!
      stat = nf90_def_dim( file_id, 'cat_aero', 22, cat_aero_dimid)
!vobiso2018S
      stat = nf90_def_dim( file_id, 'num_aero_r', 3, num_aero_r_dimid)
      stat = nf90_def_dim( file_id, 'num_aero_1', NUM_AERO+1, num_aero_1_dimid)
      stat = nf90_def_dim( file_id, 'num_engy', 7, num_engy_dimid)
!vobiso2018E
      stat = nf90_def_dim( file_id, 'num_aero', max(1,NUM_AERO), num_aero_dimid)
      stat = nf90_def_dim( file_id, 'num_gas_total', max(1,NUM_GAS_TOTAL), num_gas_total_dimid)
!
      stat = nf90_def_dim( file_id, 'label_max_length', NETCDF_LABEL_MAX_LENGTH, wrt_int_state%label_dimid )
!
! Define global variables
!
      stat = nf90_def_var( file_id, 'time', NF90_INT, (/ time_dimid /), time_varid)
      stat = nf90_put_att(file_id, time_varid,'units', 'hours since YYYY-MM-DD HH-MM UTC')
      stat = nf90_put_att(file_id, time_varid,'long_name', 'time')
      stat = nf90_put_att(file_id, time_varid,'calendar', 'standard')
      stat = nf90_put_att(file_id, time_varid,'standard_name', 'time')
!
      stat = nf90_def_var( file_id, 'lm', NF90_INT, (/ lm_dimid /), lm_varid )
      stat = nf90_put_att( file_id, lm_varid, 'units', 'unitless' )
      stat = nf90_put_att( file_id, lm_varid, 'long_name', 'layer id' )
      allocate( lm_values( LM ) )
      do k = 1, LM
        lm_values( k ) = k - 1
      end do
      stat = nf90_put_var( file_id, lm_varid, lm_values, (/ 1 /), (/ LM /) )
      deallocate( lm_values )
!
      stat = nf90_def_var( file_id, 'lmp', NF90_INT, (/ lmp_dimid /), lmp_varid )
      stat = nf90_put_att( file_id, lmp_varid, 'units', 'unitless' )
      stat = nf90_put_att( file_id, lmp_varid, 'long_name', 'vertical interface id' )
      allocate( lmp_values( LM + 1 ) )
      do k = 1, LM + 1
        lmp_values( k ) = k - 1
      end do
      stat = nf90_put_var( file_id, lmp_varid, lmp_values, (/ 1 /), (/ LM + 1 /) )
      deallocate( lmp_values )
!
      reg_grid_map = 'rotated_pole'
      if(.NOT.GLOBAL) then !REGIONAL
        stat = nf90_def_var (file_id, 'rotated_pole', NF90_CHAR, projection_id)
        stat = nf90_put_att(file_id, projection_id, 'grid_mapping_name', 'rotated_latitude_longitude')
        stat = nf90_def_var( file_id, 'rlon', NF90_FLOAT, (/ i_dimid /), rlon_id)
        stat = nf90_put_att( file_id, rlon_id, 'long_name', 'longitude in rotated_pole grid')
        stat = nf90_put_att( file_id, rlon_id, 'units', 'degrees')
        stat = nf90_put_att( file_id, rlon_id, 'standard_name', 'grid_longitude')

        stat = nf90_def_var( file_id, 'rlat', NF90_FLOAT, (/ j_dimid /), rlat_id)
        stat = nf90_put_att( file_id, rlat_id, 'long_name', 'latitude in rotated_pole grid')
        stat = nf90_put_att( file_id, rlat_id, 'units', 'degrees')
        stat = nf90_put_att( file_id, rlat_id, 'standard_name', 'grid_latitude')

        stat = nf90_put_att( file_id, NF90_GLOBAL, 'Domain', 'Regional')
      else  !GLOBAL
        stat = nf90_def_var( file_id, 'lon', NF90_FLOAT, (/ i_dimid /), rlon_id)
        stat = nf90_put_att( file_id, rlon_id, 'long_name', 'longitude')
        stat = nf90_put_att( file_id, rlon_id, 'units', 'degrees_east')
        stat = nf90_put_att( file_id, rlon_id, 'standard_name', 'longitude')

        stat = nf90_def_var( file_id, 'lat', NF90_FLOAT, (/ j_dimid /), rlat_id)
        stat = nf90_put_att( file_id, rlat_id, 'long_name', 'latitude')
        stat = nf90_put_att( file_id, rlat_id, 'units', 'degrees_north')
        stat = nf90_put_att( file_id, rlat_id, 'standard_name', 'grid_latitude')
        stat = nf90_put_att( file_id, NF90_GLOBAL, 'Domain', 'Global')
      endif 
!
      stat = nf90_put_att( file_id, NF90_GLOBAL, 'Conventions', 'None')
      stat = nf90_put_att( file_id, NF90_GLOBAL, 'history', 'MONARCHv1.0 netcdf file.')
!
      write(time_units,'(a,i4.4,a,i2.2,a,i2.2,a,i2.2,a,i2.2,a)')  'hours since ', IYEAR_FCST, '-', IMONTH_FCST, '-', IDAY_FCST,' ', IHOUR_FCST,':', IMINUTE_FCST,' UTC'
      stat = nf90_put_att(file_id, time_varid,'units', trim(time_units))
!
      stat = nf90_enddef(file_id)
! Store dimids related to netcdf
      wrt_int_state%time_dimid = time_dimid
      wrt_int_state%i_dimid = i_dimid
      wrt_int_state%j_dimid = j_dimid
      wrt_int_state%lm_dimid = lm_dimid
      wrt_int_state%lmp_dimid = lmp_dimid
      wrt_int_state%lmm_dimid = lmm_dimid
      wrt_int_state%soil_lm_dimid = soil_lm_dimid
      wrt_int_state%cat_aero_dimid = cat_aero_dimid
      wrt_int_state%num_aero_dimid = num_aero_dimid
!vobiso2018S
      wrt_int_state%num_aero_r_dimid = num_aero_r_dimid
      wrt_int_state%num_aero_1_dimid = num_aero_1_dimid
      wrt_int_state%num_engy_dimid = num_engy_dimid
!vobiso2018E
      wrt_int_state%num_gas_total_dimid = num_gas_total_dimid
!
      ELSE
      stat=nf90_open(FILENAME_FIRST_HOUR, or(nf90_write,nf90_netcdf4), file_id)
      wrt_int_state%WRITE_TIMESTEP=wrt_int_state%WRITE_TIMESTEP+1
      stat = nf90_inq_varid( wrt_int_state%IO_HST_UNIT, 'time', time_varid)
      ENDIF
! Put time value
      stat = nf90_put_var(file_id, time_varid, NF_HOURS, start=(/wrt_int_state%WRITE_TIMESTEP/)) !, count=(/1/))
!
!-----------------------------------------------------------------------
!***  Integer scalar/1-D history variables
!-----------------------------------------------------------------------
!
      if(HST_FIRST)then
      N2=0                                                                !<-- Word counter for full string of integer scalar/1D data
!
      DO N=1,wrt_int_state%KOUNT_I1D(1)                                   !<-- Loop through all scalar/1D integer data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_I1D_STRING(NPOSN_1:NPOSN_2)              !<-- The variable's name
        LENGTH=wrt_int_state%LENGTH_DATA_I1D(N)                           !<-- The variable's length in words
        ALLOCATE(WORK_ARRAY_I1D(LENGTH),stat=RC)
!
        DO N1=1,LENGTH
          N2=N2+1
          WORK_ARRAY_I1D(N1)=wrt_int_state%ALL_DATA_I1D(N2)               !<-- Extract the individual data from the data string
        ENDDO
!
        stat = nf90_redef(file_id)
!
        if(LENGTH.LE.1)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_INT, VARID)
        elseif(LENGTH.EQ.3)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_INT, (/ idat_dimid /), VARID)
        endif
!
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'long_name', TRIM(NAME))
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'units', 'unknown')
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'standard_name', TRIM(NAME))
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'missing_value', imissing_value )
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, '_FillValue', ifill_value )
        stat = nf90_enddef(file_id)
        stat = nf90_PUT_VAR(wrt_int_state%IO_HST_UNIT, VARID, WORK_ARRAY_I1D)  !<-- Lead write task writes out the 1D integer data
!
        IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
          WRITE(0,*)'Wrote ',TRIM(NAME),' to history netcdf file unit ',wrt_int_state%IO_HST_UNIT
        ENDIF
!
        DEALLOCATE(WORK_ARRAY_I1D)
!
      ENDDO
!
      endif
!
!-----------------------------------------------------------------------
!***  Real scalar/1-D history variables
!-----------------------------------------------------------------------
!
      if(HST_FIRST)then
!
      N2=0                                                                !<-- Word counter for full string of real scalar/1D data
!
      DO N=1,wrt_int_state%KOUNT_R1D(1)                                   !<-- Loop through all scalar/1D real data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_R1D_STRING(NPOSN_1:NPOSN_2)              !<-- The variable's name
        LENGTH=wrt_int_state%LENGTH_DATA_R1D(N)                           !<-- The variable's length
        ALLOCATE(WORK_ARRAY_R1D(LENGTH),stat=RC)
!
        DO N1=1,LENGTH
          N2=N2+1
          WORK_ARRAY_R1D(N1)=wrt_int_state%ALL_DATA_R1D(N2)               !<-- Extract the individual data from the data string
        ENDDO
!
        if(TRIM(NAME)=='TLM0D') tlm0d=WORK_ARRAY_R1D(LENGTH)
        if(TRIM(NAME)=='TPH0D') tph0d=WORK_ARRAY_R1D(LENGTH)
        if(TRIM(NAME)=='DPHD') lat_step=WORK_ARRAY_R1D(LENGTH)
        if(TRIM(NAME)=='DLMD')then
          lon_step=WORK_ARRAY_R1D(LENGTH)
! Put the values for the rlat and rlon variables:
          if(.not.GLOBAL) then !REGIONAL
            allocate( rlon_values( IM ), stat = RC)
            mid_val = (im+1)/2
            do i=1,im
              rlon_values(i) = lon_step *(i-mid_val)
            enddo
            stat = nf90_put_var(file_id, rlon_id,rlon_values)
            deallocate(rlon_values)
            allocate( rlat_values( jm ), stat = RC)
            mid_val = (jm+1)/2
            do i=1,jm
              rlat_values(i) = lat_step *(i-mid_val)
            enddo
            stat = nf90_put_var(file_id, rlat_id,rlat_values)
            deallocate(rlat_values)
            ! Projection variable for rotated latitude longitude domains
            stat = nf90_redef(file_id)
            call lltorll ( 90.0, 0.0, tph0d, tlm0d, north_pole_lat, north_pole_lon)
            stat = nf90_put_att(file_id, projection_id, 'grid_north_pole_latitude', north_pole_lat)
            stat = nf90_put_att(file_id, projection_id, 'grid_north_pole_longitude', north_pole_lon)
            stat = nf90_enddef(file_id)
          else  !anp uses im -2  jm -2 here
             allocate( rlon_values( im ), stat = RC)
             mid_val = (im)/2
             do i=1,im
               rlon_values(i) = lon_step *(i-mid_val)
             enddo
             stat = nf90_put_var(file_id, rlon_id, rlon_values)
             deallocate(rlon_values)
             allocate( rlat_values( jm ), stat = RC)
             mid_val = (jm)/2
             do i=1,jm
               rlat_values(i) = lat_step *(i-mid_val)
             enddo
             stat = nf90_put_var(file_id, rlat_id, rlat_values)
             deallocate(rlat_values)
           endif
        endif
!
        stat = nf90_redef(file_id)
!
        if(LENGTH.LE.1)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_FLOAT, 0, VARID)
        elseif(LENGTH.EQ.4)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_FLOAT, (/ soil_lm_dimid /), VARID)
        elseif(LENGTH.EQ.JM)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_FLOAT, (/ j_dimid /), VARID)
        elseif(LENGTH.EQ.LM)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_FLOAT, (/ lm_dimid /), VARID)
        elseif(LENGTH.EQ.LM+1)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_FLOAT, (/ lmp_dimid /), VARID)
        elseif(LENGTH.EQ.LM-1)then
          stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_FLOAT, (/ lmm_dimid /), VARID)
        endif
!
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'long_name', TRIM(NAME))
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'units', 'unknown')
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'standard_name', TRIM(NAME))
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'missing_value', missing_value )
        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, '_FillValue', fill_value )
        stat = nf90_enddef(file_id)
        stat = nf90_PUT_VAR(wrt_int_state%IO_HST_UNIT, VARID, WORK_ARRAY_R1D)  !<-- Lead write task writes out the 1D real data
!
        IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
          WRITE(0,*)'Wrote ',TRIM(NAME),' to history netcdf file unit ',wrt_int_state%IO_HST_UNIT
        ENDIF
!
        DEALLOCATE(WORK_ARRAY_R1D)
!
      ENDDO
!
      endif
!
!-----------------------------------------------------------------------
!***  Logical history variables
!-----------------------------------------------------------------------
!
      if(HST_FIRST)then
!
      N2=0                                                                !<-- Counter for full string of logical data
!
      DO N=1,wrt_int_state%KOUNT_LOG(1)                                   !<-- Loop through all logical data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%NAMES_LOG_STRING(NPOSN_1:NPOSN_2)              !<-- The variable's name
!
        N2=N2+1

        WORK_LOGICAL = wrt_int_state%ALL_DATA_LOG(N2)
        WRITE_LOGICAL=WORK_LOGICAL                                        !<-- Convert from ESMF_Logical to F90 logical
!        stat = nf90_redef(file_id)
!        stat = nf90_def_var( wrt_int_state%IO_HST_UNIT, TRIM(NAME), NF90_STRING, VARID)
!        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'long_name', TRIM(NAME))
!        stat = nf90_put_att( wrt_int_state%IO_HST_UNIT, VARID, 'standard_name', TRIM(NAME))
!        stat = nf90_enddef(file_id)
!        stat = nf90_PUT_VAR(wrt_int_state%IO_HST_UNIT, VARID, WRITE_LOGICAL)  !<-- Lead write task writes out the 1D integer data
!
!        WRITE(wrt_int_state%IO_HST_UNIT,iostat=RC)WRITE_LOGICAL           !<-- Write out the data
!
        IF(HST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
          WRITE(0,*)'Still not logical Wrote ',TRIM(NAME),' to history netcdf file unit ',wrt_int_state%IO_HST_UNIT
        ENDIF
!
      ENDDO
!
      endif
!
!-----------------------------------------------------------------------
!***  Open history_INIT.hhh file for next run tracers restart
!-----------------------------------------------------------------------
!
      if( (MOD(NF_HOURS-wrt_int_state%nhrs_spinup,24) == 0 .and.        &
          (NF_HOURS-wrt_int_state%nhrs_spinup) .gt. 0)     .or.         &
          (MOD(NF_HOURS,24) == 0 .and. (NF_HOURS .gt. 0)) )then
!
        write(hist_time,'(I3.3)')NF_HOURS !-wrt_int_state%nhrs_spinup
        write(hist_dom,'(I2.2)')ID_DOMAIN
!
        IF(MOD(NF_HOURS-wrt_int_state%nhrs_spinup,24) == 0 .and.        &
          (NF_HOURS-wrt_int_state%nhrs_spinup) .gt. 0)THEN
!
!***  Create history_INIT_TRACERS
!
          WRITE(0,*)'Create history_INIT_TRACERS at ',NF_HOURS,'with spinup of ',wrt_int_state%nhrs_spinup
          WRITE(0,*)'History_INIT_TRACERS filename: ','history_INIT_TRACERS_d'//hist_dom//'.'//hist_time//'.nc'
          stat = nf90_create('history_INIT_TRACERS_d'//hist_dom//'.'//hist_time//'.nc',OR(NF90_CLOBBER,NF90_NETCDF4), wrt_int_state%IO_TRACERS_INIT_UNIT)
!
          file_hist_id = wrt_int_state%IO_TRACERS_INIT_UNIT
!
          IF (GLOBAL)THEN
            stat = nf90_def_dim( file_hist_id, 'lon', IM, i_hist_dimid)
            stat = nf90_def_dim( file_hist_id, 'lat', JM, j_hist_dimid)
          ELSE
            stat = nf90_def_dim( file_hist_id, 'rlon', IM, i_hist_dimid)
            stat = nf90_def_dim( file_hist_id, 'rlat', JM, j_hist_dimid)
          ENDIF
!
          stat = nf90_def_dim( file_hist_id, 'lm', LM, lm_hist_dimid)
          stat = nf90_def_dim( file_hist_id, 'soil_lm', 4, soil_lm_hist_dimid)
!
          wrt_int_state%i_hist_dimid = i_hist_dimid
          wrt_int_state%j_hist_dimid = j_hist_dimid
          wrt_int_state%lm_hist_dimid = lm_hist_dimid
          wrt_int_state%soil_lm_hist_dimid = soil_lm_hist_dimid
!
          stat = nf90_enddef(file_hist_id)
!
        ENDIF
!
        IF(MOD(NF_HOURS,24) == 0 .and. (NF_HOURS .gt. 0))THEN
!
!***  Create history_INIT_MET
!
          WRITE(0,*)'Create history_INIT_MET.hhh at ',NF_HOURS,'with spinup of ',wrt_int_state%nhrs_spinup
          WRITE(0,*)'History_INIT_MET filename: ','history_INIT_MET_d'//hist_dom//'.'//hist_time//'.nc'
          stat = nf90_create('history_INIT_MET_d'//hist_dom//'.'//hist_time//'.nc',OR(NF90_CLOBBER,NF90_NETCDF4), wrt_int_state%IO_MET_INIT_UNIT)

!
          file_hist_id = wrt_int_state%IO_MET_INIT_UNIT
!
          IF (GLOBAL)THEN
            stat = nf90_def_dim( file_hist_id, 'lon', IM, i_hist_dimid)
            stat = nf90_def_dim( file_hist_id, 'lat', JM, j_hist_dimid)
          ELSE
            stat = nf90_def_dim( file_hist_id, 'rlon', IM, i_hist_dimid)
            stat = nf90_def_dim( file_hist_id, 'rlat', JM, j_hist_dimid)
          ENDIF
!
          stat = nf90_def_dim( file_hist_id, 'lm', LM, lm_hist_dimid)
          stat = nf90_def_dim( file_hist_id, 'soil_lm', 4, soil_lm_hist_dimid)
!
          wrt_int_state%i_hist_dimid = i_hist_dimid
          wrt_int_state%j_hist_dimid = j_hist_dimid
          wrt_int_state%lm_hist_dimid = lm_hist_dimid
          wrt_int_state%soil_lm_hist_dimid = soil_lm_hist_dimid
!
          stat = nf90_enddef(file_hist_id)
!
        ENDIF
!
      endif
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_NETCDF_RUNHISTORY_OPEN
!
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_RUNRESTART_OPEN(WRT_INT_STATE                    &
                                      ,IYEAR_FCST                       &
                                      ,IMONTH_FCST                      &
                                      ,IDAY_FCST                        &
                                      ,IHOUR_FCST                       &
                                      ,IMINUTE_FCST                     &
                                      ,SECOND_FCST                      &
                                      ,NTIMESTEP                        &
                                      ,NF_HOURS                         &
                                      ,NF_MINUTES                       &
                                      ,NF_SECONDS                       &
                                      ,RST_FIRST                        &
                                      ,LEAD_WRITE_TASK )
!
!-----------------------------------------------------------------------
!***  Write out a binary run restart file.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE            !<-- The Write component's internal state
!
      INTEGER,INTENT(IN) :: IYEAR_FCST                                  &
                           ,IMONTH_FCST                                 &
                           ,IDAY_FCST                                   &
                           ,IHOUR_FCST                                  &
                           ,IMINUTE_FCST                                &
                           ,LEAD_WRITE_TASK                             &
                           ,NF_HOURS                                    &
                           ,NF_MINUTES                                  &
                           ,NTIMESTEP 
!
      LOGICAL,INTENT(IN) :: RST_FIRST
!
      REAL,INTENT(IN) :: NF_SECONDS,SECOND_FCST
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER :: N,N1,N2,NPOSN_1,NPOSN_2,LENGTH
      INTEGER :: NFIELD,RC
      CHARACTER(ESMF_MAXSTR)       :: NAME
      INTEGER,DIMENSION(:),POINTER :: WORK_ARRAY_I1D
      REAL(4),DIMENSION(:),POINTER :: WORK_ARRAY_R1D
      LOGICAL                      :: WRITE_LOGICAL
      LOGICAL                      :: WORK_LOGICAL
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!***  Open the restart file and write the current forecast time
!***  and elapsed time.
!-----------------------------------------------------------------------
!
      CALL OPEN_RST_FILE(WRT_INT_STATE)
!
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)IYEAR_FCST
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)IMONTH_FCST
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)IDAY_FCST
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)IHOUR_FCST
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)IMINUTE_FCST
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)SECOND_FCST
      WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)NTIMESTEP
!
      IF(RST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
        WRITE(0,*)' Wrote IYEAR_FCST to restart file unit ',wrt_int_state%IO_RST_UNIT
        WRITE(0,*)' Wrote IMONTH_FCST to restart file unit ',wrt_int_state%IO_RST_UNIT
        WRITE(0,*)' Wrote IDAY_FCST to restart file unit ',wrt_int_state%IO_RST_UNIT
        WRITE(0,*)' Wrote IHOUR_FCST to restart file unit ',wrt_int_state%IO_RST_UNIT
        WRITE(0,*)' Wrote IMINUTE_FCST to restart file unit ',wrt_int_state%IO_RST_UNIT
        WRITE(0,*)' Wrote SECOND_FCST to restart file unit ',wrt_int_state%IO_RST_UNIT
        WRITE(0,*)' Wrote NTIMESTEP to restart file unit ',wrt_int_state%IO_RST_UNIT
      ENDIF
!
!-----------------------------------------------------------------------
!***  Integer scalar/1-D restart variables
!-----------------------------------------------------------------------
!
        N2=0                                                               !<-- Word counter for full string of integer scalar/1D data
!
        DO N=1,wrt_int_state%RST_KOUNT_I1D(1)                              !<-- Loop through all scalar/1D integer data
!
          NPOSN_1=(N-1)*ESMF_MAXSTR+1
          NPOSN_2=N*ESMF_MAXSTR
          NAME=wrt_int_state%RST_NAMES_I1D_STRING(NPOSN_1:NPOSN_2)         !<-- The variable's name
          LENGTH=wrt_int_state%RST_LENGTH_DATA_I1D(N)                      !<-- The variable's length in words
          ALLOCATE(WORK_ARRAY_I1D(LENGTH),stat=RC)
!
          DO N1=1,LENGTH
            N2=N2+1
            WORK_ARRAY_I1D(N1)=wrt_int_state%RST_ALL_DATA_I1D(N2)          !<-- Extract the individual data from the data string
          ENDDO
!
          WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)WORK_ARRAY_I1D         !<-- Write out the data
!
          IF(RST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
            WRITE(0,*)'Wrote ',TRIM(NAME),' to restart file unit ',wrt_int_state%IO_RST_UNIT
          ENDIF
!
          DEALLOCATE(WORK_ARRAY_I1D)
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Real scalar/1-D restart variables
!-----------------------------------------------------------------------
!
        N2=0                                                               !<-- Word counter for full string of real scalar/1D data
!
        DO N=1,wrt_int_state%RST_KOUNT_R1D(1)                              !<-- Loop through all scalar/1D real data
!
          NPOSN_1=(N-1)*ESMF_MAXSTR+1
          NPOSN_2=N*ESMF_MAXSTR
          NAME=wrt_int_state%RST_NAMES_R1D_STRING(NPOSN_1:NPOSN_2)         !<-- The variable's name
          LENGTH=wrt_int_state%RST_LENGTH_DATA_R1D(N)                      !<-- The variable's length
          ALLOCATE(WORK_ARRAY_R1D(LENGTH),stat=RC)
!
          DO N1=1,LENGTH
            N2=N2+1
            WORK_ARRAY_R1D(N1)=wrt_int_state%RST_ALL_DATA_R1D(N2)          !<-- Extract the individual data from the data string
          ENDDO
!
          WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)WORK_ARRAY_R1D         !<-- Write out the data
!
          IF(RST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
            WRITE(0,*)'Wrote ',TRIM(NAME),' to restart file unit ',wrt_int_state%IO_RST_UNIT
          ENDIF
!
          DEALLOCATE(WORK_ARRAY_R1D)
!
        ENDDO
!
!-----------------------------------------------------------------------
!***  Logical restart variables
!-----------------------------------------------------------------------
!
        N2=0                                                               !<-- Counter for full string of logical data
!
        DO N=1,wrt_int_state%RST_KOUNT_LOG(1)                              !<-- Loop through all logical data
!
          NPOSN_1=(N-1)*ESMF_MAXSTR+1
          NPOSN_2=N*ESMF_MAXSTR
          NAME=wrt_int_state%RST_NAMES_LOG_STRING(NPOSN_1:NPOSN_2)         !<-- The variable's name
!
          N2=N2+1
          WORK_LOGICAL = wrt_int_state%RST_ALL_DATA_LOG(N2)
          WRITE_LOGICAL=WORK_LOGICAL                                       !<-- Convert from ESMF_Logical to F90 logical
!
          WRITE(wrt_int_state%IO_RST_UNIT,iostat=RC)WRITE_LOGICAL          !<-- Write out the data
!
          IF(RST_FIRST .AND. (wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL) )THEN
            WRITE(0,*)'Wrote ',TRIM(NAME),' to restart file unit ',wrt_int_state%IO_RST_UNIT
          ENDIF
!
        ENDDO
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_RUNRESTART_OPEN
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_NEMSIO_RUNRESTART_OPEN(WRT_INT_STATE             &
                                        ,NEMSIOFILE                     &
                                        ,IYEAR_FCST                     &
                                        ,IMONTH_FCST                    &
                                        ,IDAY_FCST                      &
                                        ,IHOUR_FCST                     &
                                        ,IMINUTE_FCST                   &
                                        ,SECOND_FCST                    &
                                        ,NTIMESTEP                      &
                                        ,NF_HOURS                       &
                                        ,NF_MINUTES                     &
                                        ,NF_SECONDS                     &
                                        ,DIM1,DIM2,NFRAME,GLOBAL        &
                                        ,ID_DOMAIN                      &
                                        ,LEAD_WRITE_TASK)
!
!-----------------------------------------------------------------------
!***  Write out a NEMSIO binary run history file.
!-----------------------------------------------------------------------
!
!------------------------
!***  Argument Variables
!------------------------
!
      TYPE(WRITE_INTERNAL_STATE),INTENT(INOUT) :: WRT_INT_STATE             !<-- The Write component's internal state
!
      TYPE(NEMSIO_GFILE),INTENT(INOUT)         :: NEMSIOFILE                !<-- The nemsio file handler
!
      INTEGER,INTENT(IN)  :: IYEAR_FCST                                 &
                            ,IMONTH_FCST                                &
                            ,IDAY_FCST                                  &
                            ,IHOUR_FCST                                 &
                            ,IMINUTE_FCST                               &
                            ,NF_HOURS                                   &
                            ,NF_MINUTES                                 &
                            ,ID_DOMAIN                                  &
                            ,LEAD_WRITE_TASK                            &
			    ,NTIMESTEP

      INTEGER,INTENT(OUT) :: DIM1,DIM2,NFRAME         
      LOGICAL,INTENT(OUT) :: GLOBAL
!
      REAL,INTENT(IN)     :: NF_SECONDS                                 &
                            ,SECOND_FCST
!
!---------------------
!***  Local Variables
!---------------------
!
      INTEGER :: I,J,N,N1,N2,NPOSN_1,NPOSN_2,LENGTH,MAXLENGTH
!
      INTEGER :: FIELDSIZE,IM,JM,LM,IDATE(7),FCSTDATE(7)                &
                ,INDX_2D,IRET,IND1,IND2,IND3,IND4,IND5,CNT              &
 		,INI1,INI2,INI3                                         &
                ,N2ISCALAR,N2IARY,N2RSCALAR,N2RARY,N2LSCALAR            &
                ,NMETA,NSOIL,TLMETA,VLEV    
!
      INTEGER :: FRAC_SEC,INT_SEC,NFIELD,RC
!
      INTEGER,DIMENSION(:),POINTER :: ARYILEN                           &
                                     ,ARYRLEN                           &
                                     ,RECLEV                            &
                                     ,VARIVAL
!
      INTEGER,DIMENSION(:,:),POINTER :: ARYIVAL
!
      REAL(4) :: DEGRAD,DXCTL,DYCTL,TPH0D,TLM0D
!
      REAL(4),DIMENSION(:),POINTER :: DX,DY,DXH                         &
                                     ,GLAT1D,GLON1D
!
      REAL(4),DIMENSION(:,:,:),POINTER :: VCOORD
!
      REAL(KIND=KFPT),DIMENSION(:)  ,POINTER :: VARRVAL
      REAL(KIND=KFPT),DIMENSION(:,:),POINTER :: ARYRVAL
!
      LOGICAL,DIMENSION(:),POINTER :: VARLVAL
!
      CHARACTER(6)  :: MODEL_LEVEL
      CHARACTER(16) :: VLEVTYP,FILE_ENDIAN
!
      CHARACTER(16),DIMENSION(:),POINTER :: ARYINAME                    &
                                           ,ARYRNAME                    &
                                           ,RECNAME                     &
                                           ,VARINAME                    &
                                           ,VARRNAME                    &
                                           ,VARLNAME
!
      CHARACTER(16),DIMENSION(:),POINTER :: RECLEVTYP
!
      CHARACTER(ESMF_MAXSTR) :: NAME,FILENAME

      LOGICAL            :: WORK_LOGICAL

      INTEGER :: NDYH=0,NDXH=0,NPT=0,NPDTOP=0,NREC=0                    &
                ,NSG1=0,NSG2=0,NSGML1=0,NSGML2=0
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
      FCSTDATE(1)=IYEAR_FCST
      FCSTDATE(2)=IMONTH_FCST
      FCSTDATE(3)=IDAY_FCST
      FCSTDATE(4)=IHOUR_FCST
      FCSTDATE(5)=IMINUTE_FCST
      FCSTDATE(6)=NINT(SECOND_FCST*100.)
      FCSTDATE(7)=100
!
!-----------------------------------------------------------------------
!***  Integer scalar/1-D history variables
!-----------------------------------------------------------------------
!
!-------------------------------------------------------------
!*** Find out the total number of int scalars and int arrays.
!-------------------------------------------------------------
!
      N2ISCALAR=0
      N2IARY=0
      MAXLENGTH=1
!
      DO N=1,wrt_int_state%RST_KOUNT_I1D(1)                                    !<-- Loop through all scalar/1D integer data
        LENGTH=wrt_int_state%RST_LENGTH_DATA_I1D(N)
!
        IF(LENGTH==1)THEN
          N2ISCALAR=N2ISCALAR+1
        ELSE
          N2IARY=N2IARY+1
          MAXLENGTH=MAX(LENGTH,MAXLENGTH)
        ENDIF
!
      ENDDO
!
      N2ISCALAR=N2ISCALAR+1
      N2IARY=N2IARY+1
      MAXLENGTH=MAX(MAXLENGTH,7)
      ALLOCATE(VARINAME(N2ISCALAR),VARIVAL(N2ISCALAR))
      ALLOCATE(ARYINAME(N2IARY),ARYILEN(N2IARY),ARYIVAL(MAXLENGTH,N2IARY))
!
!---------------------------------------
!***  Set value to AVRIVAL and ARYIVAL.
!---------------------------------------
!
      N2=0                                                                 !<-- Word counter for full string of integer scalar/1D data
      N2ISCALAR=0
      N2IARY=0
      IDATE=0
!
      DO N=1,wrt_int_state%RST_KOUNT_I1D(1)                                    !<-- Loop through all scalar/1D integer data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%RST_NAMES_I1D_STRING(NPOSN_1:NPOSN_2)               !<-- The variable's name
        LENGTH=wrt_int_state%RST_LENGTH_DATA_I1D(N)                            !<-- The variable's length in words
!
        IF(LENGTH==1)THEN
          N2=N2+1
          N2ISCALAR=N2ISCALAR+1
          VARINAME(N2ISCALAR)=TRIM(NAME)
          VARIVAL(N2ISCALAR)=wrt_int_state%RST_ALL_DATA_I1D(N2)
!     if(n2==10)then
!       write(0,*)' WRITE_NEMSIO_RUNRESTART_OPEN n2iscalar=',n2iscalar &
!                ,' VARIVAL(N2ISCALAR)=',VARIVAL(N2ISCALAR),' variname=',variname(n2iscalar)
!     endif
          IF(VARINAME(N2ISCALAR)=='IHRST') then
            IDATE(4)=VARIVAL(N2ISCALAR)
          ENDIF
        ELSE
          N2IARY=N2IARY+1
          ARYINAME(N2IARY)=TRIM(NAME)
          ARYILEN(N2IARY)=LENGTH
!            write(0,*)'in I1D array,aryiname=',aryiname(N2IARY),'len=',aryilen(N2IARY),  &
!              wrt_int_state%RST_ALL_DATA_I1D(N2+1:N2+length)
!
          DO N1=1,LENGTH
            N2=N2+1
            ARYIVAL(N1,N2IARY)=wrt_int_state%RST_ALL_DATA_I1D(N2)              !<-- Extract the individual data from the data string
          ENDDO

          IF(ARYINAME(N2IARY)=='IDAT') THEN
            IDATE(1)=ARYIVAL(3,N2IARY)
            IDATE(2)=ARYIVAL(2,N2IARY)
            IDATE(3)=ARYIVAL(1,N2IARY)
            IDATE(7)=100.
          ENDIF
!
!           write(0,*)'in I1D array,aryival=',aryival(:,N2IARY)
        ENDIF
!
      ENDDO
!------------------------------
!***  Add ntimestep into VARI.
!------------------------------
!
     N2ISCALAR= N2ISCALAR+1
     VARINAME(N2ISCALAR)='NTIMESTEP'
     VARIVAL(N2ISCALAR)=NTIMESTEP
!     write(0,*)'in I1D scalar,varival=',varival,'varname=',variname
!
!
!------------------------------
!***  Add fcst_date into ARYI.
!------------------------------
!
      N2IARY=N2IARY+1
      ARYINAME(N2IARY)='FCSTDATE'
      ARYILEN(N2IARY)=7
      ARYIVAL(1:7,N2IARY)=FCSTDATE(1:7)
!
!-----------------------------------------------------------------------
!***  Real scalar/1-D history variables
!-----------------------------------------------------------------------
!
!------------------------------------------------------------
!***  Find the total number of real scalars and real arrays.
!------------------------------------------------------------
!
      N2RSCALAR=0
      N2RARY=0
      MAXLENGTH=1
!
      DO N=1,wrt_int_state%RST_KOUNT_R1D(1)                                    !<-- Loop through all scalar/1D real data
        LENGTH=wrt_int_state%RST_LENGTH_DATA_R1D(N)                            !<-- The variable's length
        IF(LENGTH==1)THEN
           N2RSCALAR=N2RSCALAR+1
        ELSE
          N2RARY=N2RARY+1
          MAXLENGTH=MAX(LENGTH,MAXLENGTH)
        ENDIF
      ENDDO
!
      ALLOCATE(VARRNAME(N2RSCALAR),VARRVAL(N2RSCALAR))
      ALLOCATE(ARYRNAME(N2RARY),ARYRLEN(N2RARY),ARYRVAL(MAXLENGTH,N2RARY))
!
!------------------------------------------------------
!***  Set values for the real scalars and real arrays.
!------------------------------------------------------
      N2=0                                                                 !<-- Word counter for full string of real scalar/1D data
      N2RSCALAR=0
      N2RARY=0
!
      DO N=1,wrt_int_state%RST_KOUNT_R1D(1)                                    !<-- Loop through all scalar/1D real data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%RST_NAMES_R1D_STRING(NPOSN_1:NPOSN_2)               !<-- The variable's name
        LENGTH=wrt_int_state%RST_LENGTH_DATA_R1D(N)                            !<-- The variable's length
!
        IF(LENGTH==1)THEN
          N2=N2+1
          N2RSCALAR=N2RSCALAR+1
          VARRNAME(N2RSCALAR)=TRIM(NAME)
          VARRVAL(N2RSCALAR)=wrt_int_state%RST_ALL_DATA_R1D(N2)
!
          IF( TRIM(NAME)=='PT') THEN
            NPT=N2RSCALAR
          ELSEIF ( TRIM(NAME)=='PDTOP') THEN
            NPDTOP=N2RSCALAR
          ELSEIF ( TRIM(NAME)=='DYH') THEN
            NDYH=N2RSCALAR
          ELSEIF ( TRIM(NAME)=='TPH0D') THEN
            TPH0D=VARRVAL(N2RSCALAR)
          ELSEIF ( trim(NAME)=='TLM0D') THEN
            TLM0D=VARRVAL(N2RSCALAR)
          ENDIF
!
        ELSE
          N2RARY=N2RARY+1
          ARYRNAME(N2RARY)=TRIM(NAME)
          ARYRLEN(N2RARY)=LENGTH
!
          DO N1=1,LENGTH
            N2=N2+1
            ARYRVAL(N1,N2RARY)=wrt_int_state%RST_ALL_DATA_R1D(N2)              !<-- Extract the individual data from the data string
          ENDDO
!
          IF( TRIM(NAME)=='SG1') THEN
            NSG1=N2RARY
          ELSEIF ( TRIM(NAME)=='SG2') THEN
            NSG2=N2RARY
          ELSEIF ( TRIM(NAME)=='SGML1' ) THEN
            NSGML1=N2RARY
          ELSEIF (TRIM(NAME)=='SGML2') THEN
            NSGML2=N2RARY
          ELSEIF (TRIM(NAME)=='DXH') THEN
            NDXH=N2RARY
          ENDIF

        ENDIF
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Logical history variables
!-----------------------------------------------------------------------
!
      N2LSCALAR=wrt_int_state%RST_KOUNT_LOG(1)                                 !<-- Counter for full string of logical data
!
      ALLOCATE(VARLNAME(N2LSCALAR),VARLVAL(N2LSCALAR))
      N2LSCALAR=0
!
      DO N=1,wrt_int_state%RST_KOUNT_LOG(1)                                    !<-- Loop through all logical data
!
        NPOSN_1=(N-1)*ESMF_MAXSTR+1
        NPOSN_2=N*ESMF_MAXSTR
        NAME=wrt_int_state%RST_NAMES_LOG_STRING(NPOSN_1:NPOSN_2)               !<-- The variable's name
!
        N2LSCALAR=N2LSCALAR+1

        WORK_LOGICAL = wrt_int_state%RST_ALL_DATA_LOG(N2LSCALAR)

        VARLNAME(N2LSCALAR)=NAME

        VARLVAL(N2LSCALAR)=wrt_int_state%RST_ALL_DATA_LOG(N2LSCALAR)

        IF(TRIM(NAME)=='GLOBAL') GLOBAL=WORK_LOGICAL
!
      ENDDO
!
!-----------------------------------------------------------------------
!***  Now open NEMSIO file.
!-----------------------------------------------------------------------
!
      N=LEN_TRIM(wrt_int_state%RST_NAME_BASE)
      INT_SEC=INT(wrt_int_state%NFSECONDS)
      FRAC_SEC=NINT((wrt_int_state%NFSECONDS-INT_SEC)*100.)
      WRITE(FILENAME,100)wrt_int_state%RST_NAME_BASE(1:N)//'_nio_'    &
                        ,wrt_int_state%NFHOURS,'h_'                   &
                        ,wrt_int_state%NFMINUTES,'m_'                 &
                        ,INT_SEC,'.',FRAC_SEC,'s'
      IF(wrt_int_state%PRINT_OUTPUT .OR. wrt_int_state%PRINT_ALL)     &
      write(0,*)'FILENAME=',trim(FILENAME),'n=',n
  100 FORMAT(A,I4.4,A,I2.2,A,I2.2,A,I2.2,A)
!
!----------------------------------------------------
!***  Prepare variables needed by the nemsip header:
!----------------------------------------------------
!
!dimension
      IF(GLOBAL) THEN
!for global im/jm for data field
        NFRAME=1
      ELSE
!for regional
        NFRAME=0
      ENDIF
      IM=wrt_int_state%im(1)
      JM=wrt_int_state%jm(1)
      DIM1=wrt_int_state%im(1)-2*NFRAME
      DIM2=wrt_int_state%jm(1)-2*NFRAME
!
      LM=wrt_int_state%LM(1)
!
!for nmmb trimmed domain
      FIELDSIZE=IM*JM
      NREC=wrt_int_state%RST_KOUNT_I2D(1)+wrt_int_state%RST_KOUNT_R2D(1)+2 !add fact10 for GSI
                                                                           !add hgt for unified code
!
!vcoord
      ALLOCATE(VCOORD(LM+1,3,2))
      VCOORD=0.
      if(NSG1>0.and.NSG2>0.and.NPT>0.and.NPDTOP>0 ) THEN
        VCOORD(1:LM+1,1,1)=0.1*(ARYRVAL(1:LM+1,NSG1)*VARRVAL(NPDTOP)      &
          -ARYRVAL(1:LM+1,NSG2)*(VARRVAL(NPDTOP)+VARRVAL(NPT))            &
          +VARRVAL(NPT) )
        VCOORD(1:LM+1,2,1)=ARYRVAL(1:LM+1,NSG2)
        VCOORD(1:LM+1,3,1)=0
      ENDIF
      if(NSGML1>0.and.NSGML2>0.and.NPT>0.and.NPDTOP>0 ) THEN
        VCOORD(1:LM,1,2)=0.1*(ARYRVAL(1:LM,NSGML1)*VARRVAL(NPDTOP)        &
          -ARYRVAL(1:LM,NSGML2)*(VARRVAL(NPDTOP)+VARRVAL(NPT))            &
          +VARRVAL(NPT) )
        VCOORD(1:LM,2,2)=ARYRVAL(1:LM,NSGML2)
        VCOORD(1:LM,3,2)=0
      ENDIF
!!!     write(0,*)'after vcoord,count_I2d=',wrt_int_state%rst_kount_I2D(1),'nrec=',nrec
!
!-----------------------------------------------------------------------
!***  Cut the output I2D array.
!-----------------------------------------------------------------------
!
      ALLOCATE(RECNAME(NREC),RECLEVTYP(NREC),RECLEV(NREC))
      NREC=0
      INI1=0                                                               !<-- # of 1-layer vars
      INI2=0                                                               !<-- # of total layes of vars with lm layers
      INI3=0                                                               !<-- # of total layes of vars with lm+1 layers
!
      DO NFIELD=1,wrt_int_state%RST_KOUNT_I2D(1)
!
        NREC=NREC+1
        NPOSN_1=(NFIELD-1)*ESMF_MAXSTR+1
        NPOSN_2=NFIELD*ESMF_MAXSTR
        NAME=wrt_int_state%RST_NAMES_I2D_STRING(NPOSN_1:NPOSN_2)           !<-- The name of this 2D integer history quantity
        INDX_2D=index(NAME,"_2D")
!
        IF (INDX_2D > 0) THEN
          MODEL_LEVEL=NAME(INDX_2D-3:INDX_2D-1)
          RECLEV(NREC)=(ICHAR(MODEL_LEVEL(1:1))-48)*100+(ICHAR(MODEL_LEVEL(2:2))-48)*10+ICHAR(MODEL_LEVEL(3:3))-48
          RECNAME(NREC)=NAME(1:INDX_2D-5)
          RECLEVTYP(NREC)='mid_layer'
          IF (RECLEV(NREC)==LM+1) THEN
            RECLEVTYP(NREC-LM:NREC)='layer'
            INI3=INI3+LM+1
            INI2=INI2-(LM+1)
          ENDIF
          INI2=INI2+1
        ELSE
          RECNAME(NREC)=TRIM(NAME)
          RECLEV(NREC)=1
          RECLEVTYP(NREC)='sfc'
          INI1=INI1+1
        ENDIF
!
        IF (RECNAME(NREC)=='ISLTYP') RECNAME(NREC)='sltyp'
        IF (RECNAME(NREC)=='IVGTYP') RECNAME(NREC)='vgtyp'
        IF (RECNAME(NREC)=='NCFRCV') RECNAME(NREC)='cfrcv'
        IF (RECNAME(NREC)=='NCFRST') RECNAME(NREC)='cfrst'
        CALL LOWERCASE(RECNAME(NREC))
      ENDDO
!
!     write(0,*)'after I2D,nrec=',nrec
!
!-----------------------------------------------------------------------
!*** Cut the output R2D array.
!-----------------------------------------------------------------------
!
      NSOIL=0
      IND1=0                                                               !<-- # of 1-layer vars
      IND2=0                                                               !<-- # of total layers for vars with lm layers 
      IND3=0                                                               !<-- # of total layers for vars with lm+1 layers
      IND4=0                                                               !<-- # of total layers for vars with nsoil layers
      IND5=0                                                               !<-- # of total layers for vars with lm-1 layers
!
      DO NFIELD=1,wrt_int_state%RST_KOUNT_R2D(1)
!
        NREC=NREC+1
        NPOSN_1=(NFIELD-1)*ESMF_MAXSTR+1
        NPOSN_2=NFIELD*ESMF_MAXSTR
        NAME=wrt_int_state%RST_NAMES_R2D_STRING(NPOSN_1:NPOSN_2)  !<-- The name of this 2D integer history quantity
        INDX_2D=INDEX(NAME,"_2D")
!
        IF (INDX_2D > 0) THEN
          MODEL_LEVEL=NAME(INDX_2D-3:INDX_2D-1)
          RECLEV(NREC)=(ICHAR(MODEL_LEVEL(1:1))-48)*100+(ICHAR(MODEL_LEVEL(2:2))-48)*10+ICHAR(MODEL_LEVEL(3:3))-48
          RECNAME(NREC)=NAME(1:INDX_2D-5)
          RECLEVTYP(NREC)='mid layer'
          IF (RECNAME(NREC)=='SMC') NSOIL=NSOIL+1
          IF (RECNAME(NREC)=='W') RECNAME(NREC)='vvel'
          IF (RECNAME(NREC)=='CW') RECNAME(NREC)='clwmr'
          IF (RECNAME(NREC)=='U') RECNAME(NREC)='ugrd'
          IF (RECNAME(NREC)=='V') RECNAME(NREC)='vgrd'
          IF (RECNAME(NREC)=='T') RECNAME(NREC)='tmp'
          IF (RECNAME(NREC)=='Q') RECNAME(NREC)='spfh'
          IF (RECNAME(NREC)=='O3') RECNAME(NREC)='o3mr'
          IF (RECLEV(NREC)==LM+1) THEN
            RECLEVTYP(NREC-LM:NREC)='layer'
            IND3=IND3+LM+1
            IND2=IND2-(LM+1)
          ENDIF
          IF (RECNAME(NREC)=='PSGDT') THEN
            RECLEVTYP(NREC)='layerm1'
            IF (RECLEV(NREC)==LM-1) THEN
              IND5=IND5+LM-1
              IND2=IND2-(LM-1)
            ENDIF
          ENDIF
          IF (RECNAME(NREC)=='PINT') THEN
            RECNAME(NREC)='pres'
          ELSE IF (RECNAME(NREC)=='SMC'.OR.RECNAME(NREC)=='SH2O'.or.RECNAME(NREC)=='STC') THEN
            RECLEVTYP(NREC)='soil layer'
            IND4=IND4+1
            IND2=IND2-1
          ENDIF
          IND2=IND2+1
        ELSE
          RECLEV(NREC)=1
          RECNAME(NREC)=TRIM(NAME)
          RECLEVTYP(NREC)='sfc'
!
          IF (INDEX(RECNAME(NREC),"10")>0) RECLEVTYP(NREC)='10 m above gnd'
          IF (RECNAME(NREC)=='PD') THEN
            RECNAME(NREC)='dpres'
            RECLEVTYP(NREC)='hybrid sig lev'
          ENDIF
!
          IF (RECNAME(NREC)=='SST') RECNAME(NREC)='tsea'
          IF (RECNAME(NREC)=='USTAR') RECNAME(NREC)='uustar'
          IF (RECNAME(NREC)=='Z0') RECNAME(NREC)='zorl'
          IND1=IND1+1
        ENDIF
!
        CALL LOWERCASE(RECNAME(NREC))
      ENDDO
!     write(0,*)'after R2D,nrec=',nrec,'kount_r2d=',wrt_int_state%RST_KOUNT_R2D(1)
!
!for fact10
      NREC=NREC+1
      RECNAME(NREC)='fact10'
      RECLEVTYP(NREC)='10 m above gnd'
      RECLEV(NREC)=1
!for hgt
      NREC=NREC+1
      RECNAME(NREC)='hgt'
      RECLEVTYP(NREC)='sfc'
      RECLEV(NREC)=1
!
!glat1d and glon1d
      ALLOCATE(GLAT1D(FIELDSIZE),GLON1D(FIELDSIZE))
      DEGRAD=90./ASIN(1.)
      glon1d=0.
      glat1d=0.
      NMETA=12
!     write(0,*)'after glat1d,NDYH=',ndyh
!
!dx and dy
      ALLOCATE(DX(FIELDSIZE),DY(FIELDSIZE))
!
      if(NDXH>0) then
       DO J=1,JM
       DO I=1,IM
         DX(I+(J-1)*IM)=ARYRVAL(J,NDXH)
       ENDDO
       ENDDO
!      write(0,*)'after dx=',maxval(dx),minval(dx),'dy=',maxval(dy),minval(dy)
      else
       NMETA=7
      endif
!
      if(NDYH>0) then
       DO I=1,FIELDSIZE
        DY(I)=VARRVAL(NDYH)
       ENDDO
      endif
!     write(0,*)'after DY,nrec=',nrec

!
!-----------------------------------------------------------------------
!                      SET UP NEMSIO WRITE
!-----------------------------------------------------------------------
!
      CALL NEMSIO_INIT(IRET=IRET)
!
!-----------------------------------------------------------------------
!***  Open NEMSIO file
!-----------------------------------------------------------------------
!
      CALL NEMSIO_OPEN(NEMSIOFILE,trim(FILENAME),'write',iret,           &
        modelname="NMMB", gdatatype="bin4", idate=IDATE,nfhour=NF_HOURS, &
        nfminute=NF_MINUTES,nfsecondn=nint(NF_SECONDS*100),              &
        nfsecondd=100,dimx=DIM1,dimy=DIM2,dimz=LM,nframe=NFRAME,         &
        nmeta=NMETA,                                                     &
        nsoil=NSOIL,ntrac=3,nrec=nrec, ncldt=1,rlon_min=minval(glon1d),  &
        rlon_max=maxval(glon1d), rlat_max=maxval(glat1d),                &
        rlat_min=minval(glat1d),vcoord=vcoord,lon=glon1d,lat=glat1d,     &
        dx=dx,dy=dy,extrameta=.true.,nmetavari=N2ISCALAR,                &
        nmetavarr=N2RSCALAR,nmetavarl=N2LSCALAR,nmetaaryi=N2IARY,        &
        nmetaaryr=N2RARY,variname=VARINAME,varival=VARIVAL,              &
        varrname=VARRNAME,varrval=VARRVAL,varlname=VARLNAME,             &
        varlval=VARLVAL,aryiname=ARYINAME,aryilen=ARYILEN,               &
        aryival=ARYIVAL,aryrname=ARYRNAME,aryrlen=ARYRLEN,               &
        aryrval=ARYRVAL,recname=RECNAME,reclevtyp=RECLEVTYP,reclev=RECLEV)
!
!     write(0,*)' WRITE_NEMSIO_RUNRESTART_OPEN after NEMSIO_OPEN variname(10)=',variname(10) &
!              ,' varival(10)=',varival(10)
!-----------------------------------------------------------------------
!***  Get variables needed by the .ctl file.
!-----------------------------------------------------------------------
!
      IF(wrt_int_state%WRITE_NEMSIOCTL.AND.wrt_int_state%MYPE==LEAD_WRITE_TASK)THEN
        CALL NEMSIO_GETFILEHEAD(NEMSIOFILE,TLMETA=TLMETA,FILE_ENDIAN=FILE_ENDIAN)
        DXCTL=MAXVAL(DX)*180./(A*PI)
        DYCTL=MAXVAL(DY)*180./(A*PI)
        CNT=INI1           & ! # of integer 1-layer fields
           +(INI2/LM)      & ! # of integer lm-layer fields
           +(INI3/(LM+1))  & ! # of integer lm+1-layer fields
           +IND1           & ! # of real 1-layer fields
           +(IND2/LM)      & ! # of real lm-layer fields
           +(IND3/(LM+1))  & ! # of real lm+1-layer fields
           +(IND4/NSOIL)   & ! # of real nsoil-layer fields
           +(IND5/(LM-1))  & ! # of real lm-1-layer fields
           +2                ! fact10 and hgt
!
!-----------------------------------------------------------------------
!***  Write out NEMSIO ctl file.
!-----------------------------------------------------------------------
!
        CALL WRITE_NEMSIOCTL(GLOBAL,IHOUR_FCST,IDAY_FCST,IMONTH_FCST,    &
          IYEAR_FCST,FILENAME,TLMETA,IM,JM,LM,NSOIL,TLM0D,TPH0D,DXCTL,   &
          DYCTL,NF_HOURS,NREC,RECNAME,RECLEVTYP,CNT,FILE_ENDIAN,         &
          ID_DOMAIN)
      ENDIF
!
!-----------------------------------------------------------------------
!***  Clean up
!-----------------------------------------------------------------------
!
      DEALLOCATE(VCOORD,DX,DY)
      DEALLOCATE(VARINAME,VARIVAL,ARYINAME,ARYILEN,ARYIVAL)
      DEALLOCATE(VARRNAME,VARRVAL,ARYRNAME,ARYRLEN,ARYRVAL)
      DEALLOCATE(VARLNAME,VARLVAL)
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_NEMSIO_RUNRESTART_OPEN
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
      SUBROUTINE WRITE_NEMSIOCTL(GLOBAL,IHOUR_FCST,IDAY_FCST,IMONTH_FCST, &
        IYEAR_FCST,FILENAME,TLMETA,DIM1,DIM2,LM,NSOIL,TLM0D,TPH0D,DXCTL,  &
        DYCTL,NF_HOURS,NREC,RECNAME,RECLEVTYP,KOUNT_R2D,FILE_ENDIAN,      &
        ID_DOMAIN)
!
!-----------------------------------------------------------------------
!***  Write out ctl file.
!-----------------------------------------------------------------------
!
!-----------------------
!*** Argument Variables
!-----------------------
!
      INTEGER,INTENT(IN) :: DIM1,DIM2                                   &
                           ,IHOUR_FCST,IDAY_FCST,IMONTH_FCST,IYEAR_FCST &
                           ,LM,NF_HOURS,NREC,NSOIL,TLMETA,KOUNT_R2D
!
      REAL,INTENT(IN) :: DXCTL,DYCTL,TLM0D,TPH0D
!
      LOGICAL,INTENT(IN) :: GLOBAL
!
      CHARACTER(*) ,INTENT(IN) :: FILENAME
      CHARACTER(16),INTENT(IN) :: RECNAME(:)
      CHARACTER(16),INTENT(IN) :: RECLEVTYP(:)
      CHARACTER(16),INTENT(IN) :: FILE_ENDIAN
!
!---------------------
!***  Local Variables
!---------------------
!
!
      INTEGER(KIND=KINT) :: IERR,RC 
      INTEGER ID_DOMAIN,N,NEWDIM1,NEWDIM2,IO_UNIT
!
      REAL CRSDXCTL,CRSDYCTL,RATIO,XBARLON,YBARLAT,MAXLAT,MAXLON,MINLAT,MINLON
!
      CHARACTER(3)  CMON
      CHARACTER(32) DATE
      CHARACTER(64) INFILE
!
      LOGICAL OPENED
!
!-----------------------------------------------------------------------
!***********************************************************************
!-----------------------------------------------------------------------
!
!---------------------
!***  Get unit number
!---------------------
!
      DO N=51,99
        INQUIRE(N,opened=OPENED)
          IF(.NOT.OPENED)THEN
            IO_UNIT=N
            EXIT
        ENDIF
      ENDDO
!
      CALL CMONTH(IMONTH_FCST,CMON)
      WRITE(DATE,'(I2.2,A,I2.2,A3,I4.4)')IHOUR_FCST,'Z',IDAY_FCST       &
           ,CMON,IYEAR_FCST
      OPEN(IO_UNIT,file=TRIM(FILENAME)//'.ctl',form='formatted')
!
      WRITE(IO_UNIT,105)TRIM(FILENAME)
      WRITE(IO_UNIT,106)
      WRITE(IO_UNIT,107)FILE_ENDIAN
      WRITE(IO_UNIT,108)TLMETA
      WRITE(IO_UNIT,109)
!
      IF (GLOBAL) THEN
        WRITE(IO_UNIT,121)DIM1,DXCTL
        WRITE(IO_UNIT,122)DIM2,DYCTl
      ELSE
        WRITE(IO_UNIT,110)DIM1,DIM2,TLM0D,TPH0D,DXCTL,DYCTL
!
!** Read min and max lat and lon values for each grid from a file
!
        WRITE(INFILE,'(A,I2.2)')'lat_lon_bnds_',ID_DOMAIN
        OPEN(UNIT=178,FILE=INFILE,STATUS='OLD',FORM='UNFORMATTED')
          READ (178)MINLAT,MAXLAT,MINLON,MAXLON 
        CLOSE(178)
!
!** Create proper nx(newdim1) and ny(newdim2) values for nests
!
        IF(ID_DOMAIN.GT.1)THEN
          XBARLON=(MAXLON*(180./pi)-MINLON*(180./pi))/2.
          YBARLAT=(MAXLAT*(180./pi)-MINLAT*(180./pi))/2.
          NEWDIM1=(MAXLON*(180./pi)-MINLON*(180./pi))/DXCTL
          NEWDIM2=(MAXLAT*(180./pi)-MINLAT*(180./pi))/DYCTL
          WRITE(IO_UNIT,131)NEWDIM1,TLM0D-XBARLON,DXCTL
          WRITE(IO_UNIT,132)NEWDIM2,TPH0D-YBARLAT,DYCTL
        ELSE
!
!** Create proper nx(newdim1) and ny(newdim2) values for parent domain
!
          NEWDIM1=(MAXLON*(180./pi)-MINLON*(180./pi))/DXCTL
          NEWDIM2=(MAXLAT*(180./pi)-MINLAT*(180./pi))/DYCTL
!
!** If parent domain nx and ny values are too big, reduce their values,
!** and force either nx or ny to be 1500 depending on which dimension is
!** the largest.  This also requires a coarser resolution.  Keep the aspect 
!** ratio of the domain the same (nx/ny).
!
!          IF(NEWDIM1.GT.1500.OR.NEWDIM2.GT.1500)THEN
!            IF(NEWDIM1.GT.NEWDIM2)THEN
!              RATIO=REAL(NEWDIM1)/REAL(NEWDIM2)
!              CRSDXCTL=(NEWDIM1*DXCTL)/1500.
!              CRSDYCTL=(NEWDIM2*DYCTL)/(1500./RATIO)
!              NEWDIM1=1500
!              NEWDIM2=REAL(NEWDIM1)/RATIO
!            ELSEIF(NEWDIM2.GE.NEWDIM1)THEN
!              RATIO=REAL(NEWDIM2)/REAL(NEWDIM1)
!              CRSDYCTL=(REAL(NEWDIM2)*DYCTL)/1500.
!              CRSDXCTL=(REAL(NEWDIM1)*DXCTL)/(1500./RATIO)
!              NEWDIM2=1500
!              NEWDIM1=REAL(NEWDIM2)/RATIO
!            ENDIF
!            WRITE(IO_UNIT,131)NEWDIM1,MINLON*(180./pi),CRSDXCTL
!            WRITE(IO_UNIT,132)NEWDIM2,MINLAT*(180./pi),CRSDYCTL
!          ELSE
            WRITE(IO_UNIT,131)NEWDIM1,MINLON*(180./pi),DXCTL
            WRITE(IO_UNIT,132)NEWDIM2,MINLAT*(180./pi),DYCTL
!          ENDIF
        ENDIF
      ENDIF ! global/regional
!
      WRITE(IO_UNIT,113)LM
      WRITE(IO_UNIT,114)1,TRIM(DATE)
!
 105  FORMAT('dset ^',A)
 106  FORMAT('undef -9.E+20')
 107  FORMAT('options ',A16,' sequential')
 108  FORMAT('fileheader',I12.0)
 109  FORMAT('title EXP1')

 110  FORMAT('pdef ',I6,I6,' eta.u ',f8.1,f8.1,f12.6,f12.6)
 121  FORMAT('xdef ',I6,' linear  -180.000 ',f12.6)
 122  FORMAT('ydef ',I6,' linear   -90.000 ',f12.6)
 131  FORMAT('xdef ',I6,' linear  ',f8.3,' ',f12.6)
 132  FORMAT('ydef ',I6,' linear  ',f8.3,' ',f12.6)
 113  FORMAT('zdef ',I6,' linear 1 1 ')
 114  FORMAT('tdef ',I6,' linear ',A12,' 6hr')
!
      WRITE(IO_UNIT,'(A,I6)')'VARS ',KOUNT_R2D

      N=1

      DO WHILE (N<=NREC)
        IF(RECLEVTYP(N)=='mid layer') THEN
          WRITE(IO_UNIT,'(A16,I3,A)')RECNAME(N),LM,' 99 mid layer'
          N=N+LM
        ELSEIF(RECLEVTYP(N)=='layerm1') THEN
          WRITE(IO_UNIT,'(A16,I3,A)')RECNAME(N),LM-1,' 99 layer'
          N=N+LM-1
        ELSEIF(RECLEVTYP(N)=='layer') THEN
          WRITE(IO_UNIT,'(A16,I3,A)')RECNAME(N),LM+1,' 99 layer'
          N=N+LM+1
        ELSEIF(RECLEVTYP(N)=='soil layer') THEN
          WRITE(IO_UNIT,'(A16,I3,A)')RECNAME(N),NSOIL,' 99 soil layer'
          N=N+NSOIL
        ELSE
          WRITE(IO_UNIT,'(A16,A)')RECNAME(N),'  0 99 sfc'
          N=N+1
        ENDIF
      ENDDO

      WRITE(IO_UNIT,'(A8)')'endvars'
      CLOSE(IO_UNIT)
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE WRITE_NEMSIOCTL
!
!-----------------------------------------------------------------------
!
      elemental subroutine lowercase(word)
!
!-----------------------------------------------------------------------
!***  convert a word to lower case
!-----------------------------------------------------------------------
!
      character (len=*) , intent(inout) :: word
      integer :: i,ic,nlen
      nlen = len(word)
!
      do i=1,nlen
        ic = ichar(word(i:i))
        if (ic >= 65 .and. ic < 91) word(i:i) = char(ic+32)
      end do
!
!
!-----------------------------------------------------------------------
!
      end subroutine lowercase
!
!-----------------------------------------------------------------------
!
      SUBROUTINE CMONTH(IMON,CMON)
!
!-----------------------------------------------------------------------
!***  Convert month
!-----------------------------------------------------------------------
!
      INTEGER,INTENT(IN) :: IMON
      CHARACTER(LEN=3)   :: CMON
!
!-----------------------------------------------------------------------
!
      SELECT CASE (IMON)
        CASE(1)
            CMON='Jan'
        CASE(2)
            CMON='Feb'
        CASE(3)
            CMON='Mar'
        CASE(4)
            CMON='Apr'
        CASE(5)
            CMON='May'
        CASE(6)
            CMON='Jun'
        CASE(7)
            CMON='Jul'
        CASE(8)
            CMON='Aug'
        CASE(9)
            CMON='Sep'
        CASE(10)
            CMON='Oct'
        CASE(11)
            CMON='Nov'
        CASE(12)
            CMON='Dec'
      END SELECT
!
!-----------------------------------------------------------------------
!
      END SUBROUTINE CMONTH
!
!-----------------------------------------------------------------------
!
      subroutine lltorll ( old_lat, old_lon, ref_lat, ref_lon, new_lat, new_lon)
      implicit none
      real old_lat, old_lon, ref_lat, ref_lon, new_lat, new_lon
      real lat_a, lat_b, lon_a, lon_b, sin_lat, arg_a, arg_b, arg_c, dtr

     ! dtr = degrees to radians PI / 180.0
      dtr = 4.D0*DATAN(1.D0) / 180.0
      lat_a = old_lat * dtr
      lat_b = ref_lat * dtr
      lon_a = old_lon * dtr
      lon_b = ref_lon * dtr
      arg_a = cos(lat_b) * sin(lat_a) + sin(lat_b) * cos(lat_a) * cos(lon_a)
      arg_b = cos(lat_a)*sin(lon_a)
      sin_lat = cos(lon_b)*sin(lat_a)+sin(lat_b)*cos(lat_a)*cos(lon_a)
      if( sin_lat .lt.-1.0) sin_lat =-1.0
      if( sin_lat .gt. 1.0) sin_lat = 1.0
      arg_c = (cos(lat_a)*cos(lon_a)-sin(lat_b)*sin_lat) / cos(lat_b)
      new_lat = asin(arg_a) / dtr
      new_lon = atan2(arg_b, arg_c) / dtr + ref_lon
      if(new_lon .gt. 180.0) new_lon = new_lon - 360.0
      if(new_lon .lt.-180.0) new_lon = new_lon + 360.0
      end subroutine
!
!-----------------------------------------------------------------------
!
      END MODULE MODULE_WRITE_ROUTINES
!
!-----------------------------------------------------------------------
