!------------------------------------------------------------------------------- MODULE MODULE_VARS_STATE !------------------------------------------------------------------------------- USE ESMF USE MODULE_VARS USE module_CONTROL,ONLY: TIMEF IMPLICIT NONE PRIVATE PUBLIC :: PUT_VARS_IN_STATE PUBLIC :: GET_VARS_FROM_STATE PUBLIC :: DELETE_FIELDS_FROM_STATE PUBLIC :: PUT_VARS_IN_BUNDLES integer,parameter :: double=selected_real_kind(p=13,r=200) integer,parameter:: kdbl=double real(kind=kdbl) :: btim,btim0 CONTAINS !############################################################################### SUBROUTINE PUT_VARS_IN_STATE(VARS, NUM_VARS, STATE_TYPE, GRID, STATE) !------------------------------------------------------------------------------- !*** Put pointers of variables in the composite VARS array into a given !*** ESMF import/export state. !------------------------------------------------------------------------------- IMPLICIT NONE TYPE(VAR), DIMENSION(:), INTENT(IN) :: VARS INTEGER, INTENT(IN) :: NUM_VARS CHARACTER(LEN=1), INTENT(IN) :: STATE_TYPE TYPE(ESMF_Grid), INTENT(IN) :: GRID TYPE(ESMF_State ), INTENT(INOUT) :: STATE TYPE(ESMF_StateItem_Flag):: stateItemType TYPE(ESMF_Field) :: FIELD INTEGER :: KOUNT,N, RC INTEGER :: IHALO,JHALO !------------------------------------------------------------------------------- !!!!!!!!! FIX this later !!!!!!!!! FIX this later IHALO = 3 JHALO = 3 !!!!!!!!! FIX this later !!!!!!!!! FIX this later DO N=1,NUM_VARS IF (( (STATE_TYPE == 'I') .AND. VARS(N)%IMPORT ) .OR. & ( (STATE_TYPE == 'X') .AND. VARS(N)%EXPORT ) ) THEN SELECT CASE(VARS(N)%TKR) CASE(TKR_I0D) CALL ESMF_AttributeSet(state=STATE ,name=VARS(N)%VBL_NAME, value=VARS(N)%I0D, rc=RC) CASE(TKR_I1D) CASE(TKR_I2D) CASE(TKR_R0D) CALL ESMF_AttributeSet(state=STATE ,name=VARS(N)%VBL_NAME, value=VARS(N)%R0D, rc=RC) CASE(TKR_R1D) KOUNT=SIZE(VARS(N)%R1D) CALL ESMF_AttributeSet(state=STATE ,name=VARS(N)%VBL_NAME, itemCount=KOUNT, valueList=VARS(N)%R1D, rc=RC) CASE(TKR_R2D) CALL ESMF_StateGet(STATE ,VARS(N)%VBL_NAME , stateItemType, rc=RC) IF (stateItemType==ESMF_STATEITEM_NOTFOUND) THEN FIELD = ESMF_FieldCreate(grid =GRID & ,farray =VARS(N)%R2D & ,totalUWidth=(/IHALO,JHALO/) & !<-- Upper bound of halo region ,totalLWidth=(/IHALO,JHALO/) & !<-- Lower bound of halo region ,name =VARS(N)%VBL_NAME & ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) CALL ESMF_StateAddReplace(STATE ,(/FIELD/) ,rc=RC) ENDIF CASE(TKR_R3D) CALL ESMF_StateGet(STATE ,VARS(N)%VBL_NAME ,stateItemType, rc=RC) IF (stateItemType==ESMF_STATEITEM_NOTFOUND .and. ASSOCIATED(VARS(N)%R3D)) THEN FIELD = ESMF_FieldCreate(grid =GRID & ,farray =VARS(N)%R3D & ,totalUWidth =(/IHALO,JHALO/) & !<-- Upper bound of halo region ,totalLWidth =(/IHALO,JHALO/) & !<-- Lower bound of halo region ,ungriddedLBound =(/ lbound(VARS(N)%R3D,dim=3) /) & ,ungriddedUBound =(/ ubound(VARS(N)%R3D,dim=3) /) & ,name =VARS(N)%VBL_NAME & ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) CALL ESMF_StateAddReplace(STATE ,(/FIELD/) ,rc=RC) ENDIF CASE(TKR_R4D) CALL ESMF_StateGet(STATE ,VARS(N)%VBL_NAME ,stateItemType, rc=RC) IF (stateItemType==ESMF_STATEITEM_NOTFOUND) THEN FIELD = ESMF_FieldCreate(grid =GRID & ,farray =VARS(N)%R4D & ,totalUWidth =(/IHALO,JHALO/) & !<-- Upper bound of halo region ,totalLWidth =(/IHALO,JHALO/) & !<-- Lower bound of halo region ,ungriddedLBound =(/ lbound(VARS(N)%R4D,dim=3),lbound(VARS(N)%R4D,dim=4) /) & ,ungriddedUBound =(/ ubound(VARS(N)%R4D,dim=3),ubound(VARS(N)%R4D,dim=4) /) & ,name =VARS(N)%VBL_NAME & ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) CALL ESMF_StateAddReplace(STATE ,(/FIELD/),rc=RC) ENDIF CASE DEFAULT write(0,*)' TKR = ', VARS(N)%TKR, TRIM(VARS(N)%VBL_NAME) write(0,*)' This TKR Case not available in PUT_VARS_IN_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) END SELECT ENDIF END DO END SUBROUTINE PUT_VARS_IN_STATE !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& SUBROUTINE GET_VARS_FROM_STATE(VARS, NUM_VARS, STATE) !------------------------------------------------------------------------------- !*** Take allocated pointers from a given ESMF state and point VARS !*** locations at them if the VARS variable is unowned/unallocated !*** or move the pointer data into the VARS location if owned by !*** multiple components. !------------------------------------------------------------------------------- IMPLICIT NONE TYPE(VAR), DIMENSION(:), INTENT(INOUT) :: VARS INTEGER, INTENT(IN) :: NUM_VARS TYPE(ESMF_State ), INTENT(INOUT) :: STATE TYPE(ESMF_Field) :: FIELD INTEGER :: KOUNT,N, RC INTEGER :: HOLD_I0D INTEGER,DIMENSION(:) ,POINTER :: HOLD_I1D INTEGER,DIMENSION(:,:) ,POINTER :: HOLD_I2D REAL :: HOLD_R0D REAL ,DIMENSION(:) ,POINTER :: HOLD_R1D REAL ,DIMENSION(:,:) ,POINTER :: HOLD_R2D REAL ,DIMENSION(:,:,:) ,POINTER :: HOLD_R3D REAL ,DIMENSION(:,:,:,:),POINTER :: HOLD_R4D CHARACTER(LEN=32) :: VBL_NAME !------------------------------------------------------------------------------- DO N=1,NUM_VARS IF ( VARS(N)%IMPORT ) THEN VBL_NAME = TRIM(VARS(N)%VBL_NAME) SELECT CASE(VARS(N)%TKR) CASE(TKR_I0D) CALL ESMF_AttributeGet(state=STATE ,name=VARS(N)%VBL_NAME, value=VARS(N)%I0D, rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get VBL_NAME for CASE(TKR_I0D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if CASE(TKR_I1D) write(0,*)' not implemented TKR_I1D in GET_VARS_FROM_STATE ' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) CASE(TKR_I2D) CALL ESMF_StateGet(STATE ,VBL_NAME ,FIELD ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get VBL_NAME for CASE(TKR_I2D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if CALL ESMF_FieldGet(field=FIELD ,localDe=0 ,farrayPtr=HOLD_I2D ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get 2D integer array from Field in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if IF (VARS(N)%OWNED ) THEN if (size(VARS(N)%I2D) /= size(HOLD_I2D) ) then write(0,*)' size(VARS(N)%I2D) /= size(HOLD_I2D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if VARS(N)%I2D = HOLD_I2D !<-- Transfer data since multiply owned ELSE VARS(N)%I2D => HOLD_I2D !<-- Point the appropriate unallocated VARS location at allocated pointer END IF CASE(TKR_R0D) CALL ESMF_AttributeGet(state=STATE ,name=VARS(N)%VBL_NAME, value=VARS(N)%R0D, rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get VBL_NAME for CASE(TKR_R0D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if CASE(TKR_R1D) KOUNT=SIZE(VARS(N)%R1D) CALL ESMF_AttributeGet(state=STATE ,name=VARS(N)%VBL_NAME, itemCount=KOUNT, valueList=VARS(N)%R1D, rc=RC) !!! write(0,*)' not implemented TKR_R1D in UPDATE_VARS ' !!! stop CASE(TKR_R2D) CALL ESMF_StateGet(state=STATE ,itemName=VBL_NAME ,field=FIELD ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get ',trim(VBL_NAME),' for CASE(TKR_R2D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if CALL ESMF_FieldGet(field=FIELD ,localDe=0 ,farrayPtr=HOLD_R2D ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get 2D real array from Field in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if IF (VARS(N)%OWNED ) THEN if (size(VARS(N)%R2D) /= size(HOLD_R2D) ) then write(0,*)' size(VARS(N)%R2D) /= size(HOLD_R2D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if VARS(N)%R2D = HOLD_R2D !<-- Transfer data since multiply owned ELSE VARS(N)%R2D => HOLD_R2D !<-- Point the appropriate unallocated VARS location at allocated pointer END IF CASE(TKR_R3D) CALL ESMF_StateGet(STATE ,VBL_NAME ,FIELD ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get VBL_NAME for CASE(TKR_R3D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if CALL ESMF_FieldGet(field=FIELD ,localDe=0 ,farrayPtr=HOLD_R3D ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get 3D real array from Field in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if IF (VARS(N)%OWNED ) THEN if (size(VARS(N)%R3D) /= size(HOLD_R3D) ) then write(0,*)TRIM(VARS(N)%VBL_NAME), size(VARS(N)%R3D), size(HOLD_R3D) write(0,*)TRIM(VARS(N)%VBL_NAME), 'lbound ',lbound(VARS(N)%R3D), lbound(HOLD_R3D) write(0,*)TRIM(VARS(N)%VBL_NAME), 'ubound ',ubound(VARS(N)%R3D), ubound(HOLD_R3D) write(0,*)' VARS(N)%R3D) /= size(HOLD_R3D in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if VARS(N)%R3D = HOLD_R3D !<-- Transfer data since multiply owned ELSE VARS(N)%R3D => HOLD_R3D !<-- Point the appropriate unallocated VARS location at allocated pointer END IF CASE(TKR_R4D) CALL ESMF_StateGet(STATE ,VBL_NAME ,FIELD ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get VBL_NAME for CASE(TKR_R4D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if CALL ESMF_FieldGet(field=FIELD ,localDe=0 ,farrayPtr=HOLD_R4D ,rc=RC) if (rc/=ESMF_SUCCESS) then write(0,*)' Unable to get 4D real array from Field in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if IF (VARS(N)%OWNED ) THEN if (size(VARS(N)%R4D) /= size(HOLD_R4D) ) then write(0,*)TRIM(VARS(N)%VBL_NAME), size(VARS(N)%R4D), size(HOLD_R4D) write(0,*)TRIM(VARS(N)%VBL_NAME), 'lbound ',lbound(VARS(N)%R4D), lbound(HOLD_R4D) write(0,*)TRIM(VARS(N)%VBL_NAME), 'ubound ',ubound(VARS(N)%R4D), ubound(HOLD_R4D) write(0,*)' size(VARS(N)%R4D) /= size(HOLD_R4D) in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) end if VARS(N)%R4D = HOLD_R4D !<-- Transfer data since multiply owned ELSE VARS(N)%R4D => HOLD_R4D !<-- Point the appropriate unallocated VARS location at allocated pointer END IF CASE DEFAULT write(0,*)' TKR = ', VARS(N)%TKR, TRIM(VARS(N)%VBL_NAME) write(0,*)' This TKR Case is not available in GET_VARS_FROM_STATE' write(0,*)' ABORTING!' CALL ESMF_FINALIZE(endflag=ESMF_END_ABORT & ,rc =RC) END SELECT END IF END DO END SUBROUTINE GET_VARS_FROM_STATE !------------------------------------------------------------------------------- !############################################################################### !------------------------------------------------------------------------------- SUBROUTINE DELETE_FIELDS_FROM_STATE(STATE) IMPLICIT NONE TYPE(ESMF_State ), INTENT(INOUT) :: STATE INTEGER :: RC INTEGER :: i, itemcount TYPE(ESMF_Field) :: FIELD CHARACTER(LEN=10), DIMENSION(:), ALLOCATABLE :: itemNameList CALL ESMF_StateGet(STATE,itemcount=itemcount, rc=RC) ALLOCATE(itemNameList(itemcount)) CALL ESMF_StateGet(STATE,itemcount=itemcount,itemNameList=itemNameList, rc=RC) DO i=1,itemcount CALL ESMF_StateGet(STATE ,itemNameList(i) ,FIELD ,rc=RC) CALL ESMF_FieldDestroy(field=FIELD, rc=RC) END DO DEALLOCATE(itemNameList) END SUBROUTINE DELETE_FIELDS_FROM_STATE !------------------------------------------------------------------------------- !############################################################################### !------------------------------------------------------------------------------- SUBROUTINE PUT_VARS_IN_BUNDLES(VARS & ,NUM_VARS & ,GRID & ,HISTORY_BUNDLE & ,RESTART_BUNDLE) USE MODULE_ERROR_MSG,ONLY: ERR_MSG,MESSAGE_CHECK IMPLICIT NONE !------------------------ !*** Argument Variables !------------------------ TYPE(VAR), DIMENSION(:), INTENT(IN) :: VARS INTEGER, INTENT(IN) :: NUM_VARS TYPE(ESMF_Grid), INTENT(IN) :: GRID TYPE(ESMF_FieldBundle), INTENT(INOUT) :: HISTORY_BUNDLE TYPE(ESMF_FieldBundle), INTENT(INOUT) :: RESTART_BUNDLE !--------------------- !*** Local variables !--------------------- INTEGER :: K,LENGTH & ,N,M,NDIM3,NFIND & ,RC,RC_OUT INTEGER :: IHALO,JHALO INTEGER :: LDIM1,LDIM2,LDIM3,LDIM4,UDIM1,UDIM2,UDIM3,UDIM4 CHARACTER(3) :: MODEL_LEVEL CHARACTER(3) :: TRACERS_KIND CHARACTER(6) :: FMT3='(I3.3)' CHARACTER(6) :: FMT2='(I2.2)' CHARACTER(ESMF_MAXSTR) :: VBL_NAME,VBL_NAME_X TYPE(ESMF_Field) :: FIELD TYPE(ESMF_DataCopy_Flag) :: COPYFLAG=ESMF_DATACOPY_REFERENCE ! TYPE(ESMF_DataCopy_Flag) :: COPYFLAG=ESMF_DATA_COPY INTEGER :: INDX_Q2 !! FIXME !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- !*** Begin with the integer scalars. !----------------------------------------------------------------------- ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Integer Scalars into History Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_I0D) THEN IF (VARS(N)%HISTORY) THEN !<-- Take integer scalar data specified for history output CALL ESMF_AttributeSet(FIELDBUNDLE=HISTORY_BUNDLE & !<-- The Write component output history Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the integer scalar ,value =VARS(N)%I0D & !<-- The scalar being inserted into the import state ,rc =RC) END IF IF (VARS(N)%RESTART) THEN !<-- Take integer scalar data specified for restart output CALL ESMF_AttributeSet(FIELDBUNDLE=RESTART_BUNDLE & !<-- The Write component output restart Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the integer scalar ,value =VARS(N)%I0D & !<-- The scalar being inserted into the import state ,rc =RC) END IF END IF END DO ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! !----------------------------------------------------------------------- !*** The real scalars. !----------------------------------------------------------------------- ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Real Scalars into History Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_R0D) THEN IF (VARS(N)%HISTORY) THEN !<-- Take real scalar data specified for history output CALL ESMF_AttributeSet(FIELDBUNDLE=HISTORY_BUNDLE & !<-- The Write component output history Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the real scalar ,value =VARS(N)%R0D & !<-- The scalar being inserted into the history Bundle ,rc =RC) END IF IF (VARS(N)%RESTART) THEN !<-- Take real scalar data specified for restart output CALL ESMF_AttributeSet(FIELDBUNDLE=RESTART_BUNDLE & !<-- The Write component output restart Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the real scalar ,value =VARS(N)%R0D & !<-- The scalar being inserted into the restart Bundle ,rc =RC) END IF END IF END DO ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! !----------------------------------------------------------------------- !*** The 1-D integer arrays. !----------------------------------------------------------------------- ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 1-D Integer Arrays into History Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_I1D) THEN LENGTH=SIZE(VARS(N)%I1D) IF (VARS(N)%HISTORY) THEN !<-- Take 1D integer array data specified for history output CALL ESMF_AttributeSet(FIELDBUNDLE =HISTORY_BUNDLE & !<-- The Write component output history Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the integer array ,itemCount =LENGTH & !<-- # of elements in this attribute ,valueList =VARS(N)%I1D & !<-- The 1D integer being inserted into the history Bundle ,rc =RC) END IF IF (VARS(N)%RESTART) THEN !<-- Take 1D integer array data specified for restart output CALL ESMF_AttributeSet(FIELDBUNDLE =RESTART_BUNDLE & !<-- The Write component output restart Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the integer array ,itemCount =LENGTH & !<-- # of elements in this attribute ,valueList =VARS(N)%I1D & !<-- The 1D integer being inserted into the restart Bundle ,rc =RC) END IF END IF END DO ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! !----------------------------------------------------------------------- !*** The 1-D real arrays. !----------------------------------------------------------------------- ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 1-D Real Arrays into History Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_R1D) THEN LENGTH=SIZE(VARS(N)%R1D) IF (VARS(N)%HISTORY) THEN !<-- Take 1D real array data specified for history output CALL ESMF_AttributeSet(FIELDBUNDLE =HISTORY_BUNDLE & !<-- The Write component output history Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the real array ,itemCount =LENGTH & !<-- # of elements in this attribute ,valueList =VARS(N)%R1D & !<-- The 1D real being inserted into the history Bundle ,rc =RC) END IF IF (VARS(N)%RESTART) THEN !<-- Take 1D real array data specified for restart output CALL ESMF_AttributeSet(FIELDBUNDLE =RESTART_BUNDLE & !<-- The Write component output restart Bundle ,name =VARS(N)%VBL_NAME & !<-- Name of the real array ,itemCount =LENGTH & !<-- # of elements in this attribute ,valueList =VARS(N)%R1D & !<-- The 1D real being inserted into the restart Bundle ,rc =RC) END IF END IF END DO ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! !----------------------------------------------------------------------- !*** The 2-D integer arrays. !----------------------------------------------------------------------- ! IHALO=3 JHALO=3 ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_I2D) THEN IF (VARS(N)%HISTORY) THEN !<-- Take 2D integer array data specified for history output ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 2-D Integer Data into Field" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%I2D & !<-- The 2D integer array being inserted into history Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VARS(N)%VBL_NAME & !<-- Name of the 2D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Solver 2-D Integer Field into History Bundles" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( HISTORY_BUNDLE & !<-- The Write component output history Bundle , (/FIELD/) & !<-- ESMF Field holding the 2D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! END IF IF (VARS(N)%RESTART) THEN !<-- Take 2D integer array data specified for restart output ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 2-D Integer Data into Field" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%I2D & !<-- The 2D integer array being inserted into restart Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VARS(N)%VBL_NAME & !<-- Name of the 2D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 2-D Integer Field into Restart Bundles" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( RESTART_BUNDLE & !<-- The Write component output restart Bundle , (/FIELD/) & !<-- ESMF Field holding the 2D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! END IF END IF END DO ! !----------------------------------------------------------------------- !*** The 2-D real arrays. !----------------------------------------------------------------------- ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_R2D) THEN IF (VARS(N)%HISTORY) THEN !<-- Take 2D real array data specified for history output ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Solver 2-D Real Data into Field" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%R2D & !<-- The 2D real array being inserted into history Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VARS(N)%VBL_NAME & !<-- Name of the 2D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Solver 2-D Real Field into History Bundles" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( HISTORY_BUNDLE & !<-- The Write component output history Bundle , (/FIELD/) & !<-- ESMF Field holding the 2D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! END IF IF (VARS(N)%RESTART) THEN !<-- Take 2D real array data specified for restart output ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Solver 2-D Real Data into Field" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%R2D & !<-- The 2D real array being inserted into restart Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VARS(N)%VBL_NAME & !<-- Name of the 2D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert Solver 2-D Real Field into Restart Bundles" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( RESTART_BUNDLE & !<-- The Write component output restart Bundle , (/FIELD/) & !<-- ESMF Field holding the 2D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! END IF END IF END DO ! !----------------------------------------------------------------------- !*** The 3-D real arrays. !*** We are working with 3-D arrays but they are loaded layer by layer !*** into 2-D Fields. !----------------------------------------------------------------------- ! DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_R3D .and. ASSOCIATED(VARS(N)%R3D)) THEN IF (VARS(N)%HISTORY) THEN !<-- Take 3D real array data specified for history output NDIM3=UBOUND(VARS(N)%R3D,3) LDIM1=LBOUND(VARS(N)%R3D,1) UDIM1=UBOUND(VARS(N)%R3D,1) LDIM2=LBOUND(VARS(N)%R3D,2) UDIM2=UBOUND(VARS(N)%R3D,2) ! DO K=1,NDIM3 WRITE(MODEL_LEVEL,FMT3)K VBL_NAME=TRIM(VARS(N)%VBL_NAME)//'_'//MODEL_LEVEL//'_2D' ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Fill 2-D Fields with Each Level of 3-D Data" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%R3D(:,:,K) & !<-- Level K of 3D real array being inserted into history Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VBL_NAME & !<-- Name of this level of the 3D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 3-D Data into History Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( HISTORY_BUNDLE & !<-- The Write component output history Bundle , (/FIELD/) & !<-- ESMF Field holding the 3D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ENDDO ! END IF IF (VARS(N)%RESTART) THEN !<-- Take 3D real array data specified for restart output NDIM3=UBOUND(VARS(N)%R3D,3) LDIM1=LBOUND(VARS(N)%R3D,1) UDIM1=UBOUND(VARS(N)%R3D,1) LDIM2=LBOUND(VARS(N)%R3D,2) UDIM2=UBOUND(VARS(N)%R3D,2) ! DO K=1,NDIM3 WRITE(MODEL_LEVEL,FMT3)K VBL_NAME=TRIM(VARS(N)%VBL_NAME)//'_'//MODEL_LEVEL//'_2D' ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Fill 2-D Fields with Each Level of 3-D Data" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%R3D(:,:,K) & !<-- Level K of 3D real array being inserted into restart Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VBL_NAME & !<-- Name of this level of the 3D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 3-D Data into Restart Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( RESTART_BUNDLE & !<-- The Write component output restart Bundle , (/FIELD/) & !<-- ESMF Field holding the 3D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ENDDO ! END IF END IF END DO ! !----------------------------------------------------------------------- !*** The 4-D real arrays. !*** We are working with 4-D arrays but they are loaded layer by layer !*** into 2-D Fields. !----------------------------------------------------------------------- ! !!!!!!!!! FIX this later !!!!!!!!! FIX this later INDX_Q2 = 3 !!!!!!!!! FIX this later !!!!!!!!! FIX this later DO N=1,NUM_VARS IF (VARS(N)%TKR == TKR_R4D) THEN IF (VARS(N)%HISTORY) THEN !<-- Take 4D real array data specified for history output LDIM1=LBOUND(VARS(N)%R4D,1) UDIM1=UBOUND(VARS(N)%R4D,1) LDIM2=LBOUND(VARS(N)%R4D,2) UDIM2=UBOUND(VARS(N)%R4D,2) LDIM3=LBOUND(VARS(N)%R4D,3) UDIM3=UBOUND(VARS(N)%R4D,3) LDIM4=LBOUND(VARS(N)%R4D,4) UDIM4=UBOUND(VARS(N)%R4D,4) ! IF(TRIM(VARS(N)%VBL_NAME)=='TRACERS_PREV' .OR. & TRIM(VARS(N)%VBL_NAME)=='TRACERS') THEN LDIM4=INDX_Q2+1 !<-- TRACERS bounds: INDX_Q2+1 - UDIM4 ENDIF DO M=LDIM4,UDIM4 !<-- Loop through the tracers (skip unallocated pointers) DO K=LDIM3,UDIM3 !<-- Loop through the levels of the array WRITE(TRACERS_KIND,FMT3)M WRITE(MODEL_LEVEL,FMT3)K ! VBL_NAME=TRIM(VARS(N)%VBL_NAME)//'_'//TRACERS_KIND//'_'//MODEL_LEVEL//'_2D' ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Fill 2-D Fields with Each Level of 4-D Data" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%R4D(:,:,K,M) & !<-- Level K of 4D real array being inserted into history Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VBL_NAME & !<-- Name of this level of the 4D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 4-D Data into History Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( HISTORY_BUNDLE & !<-- The Write component output history Bundle , (/FIELD/) & !<-- ESMF Field holding the 4D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ENDDO ENDDO ! END IF IF (VARS(N)%RESTART) THEN !<-- Take 4D real array data specified for restart output LDIM1=LBOUND(VARS(N)%R4D,1) UDIM1=UBOUND(VARS(N)%R4D,1) LDIM2=LBOUND(VARS(N)%R4D,2) UDIM2=UBOUND(VARS(N)%R4D,2) LDIM3=LBOUND(VARS(N)%R4D,3) UDIM3=UBOUND(VARS(N)%R4D,3) LDIM4=LBOUND(VARS(N)%R4D,4) UDIM4=UBOUND(VARS(N)%R4D,4) ! IF( TRIM(VARS(N)%VBL_NAME)=='TRACERS') THEN LDIM4=INDX_Q2+1 !<-- TRACERS bounds: INDX_Q2+1 - UDIM4 ENDIF ! DO M=LDIM4,UDIM4 !<-- Loop through the tracers (skip unallocated pointers) DO K=LDIM3,UDIM3 !<-- Loop through the levels of the array WRITE(TRACERS_KIND,FMT3)M WRITE(MODEL_LEVEL,FMT3)K ! VBL_NAME=TRIM(VARS(N)%VBL_NAME)//'_'//TRACERS_KIND//'_'//MODEL_LEVEL//'_2D' ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Fill 2-D Fields with Each Level of 4-D Data" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! FIELD=ESMF_FieldCreate(grid =GRID & !<-- The ESMF grid ,farray =VARS(N)%R4D(:,:,K,M) & !<-- Level K of 4D real array being inserted into restart Bundle ,datacopyflag =COPYFLAG & ,totalUWidth =(/IHALO,JHALO/) & ,totalLWidth =(/IHALO,JHALO/) & ,name =VBL_NAME & !<-- Name of this level of the 4D real array ,indexFlag =ESMF_INDEX_GLOBAL & ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ MESSAGE_CHECK="Insert 4-D Data into Restart Bundle" ! CALL ESMF_LogWrite(MESSAGE_CHECK,ESMF_LOGMSG_INFO,rc=RC) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! CALL ESMF_FieldBundleAdd( RESTART_BUNDLE & !<-- The Write component output restart Bundle , (/FIELD/) & !<-- ESMF Field holding the 4D real array ,rc =RC) ! ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ CALL ERR_MSG(RC,MESSAGE_CHECK,RC_OUT) ! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ! ENDDO ENDDO ! END IF END IF END DO ! !----------------------------------------------------------------------- ! END SUBROUTINE PUT_VARS_IN_BUNDLES !------------------------------------------------------------------------------- !############################################################################### !------------------------------------------------------------------------------- END MODULE MODULE_VARS_STATE