assemble_bundle Subroutine

subroutine assemble_bundle(bundle, grid, datacopyflag, farray1, farray2, farray3, farray4, do_slicing, do_slicing1, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_FieldBundle) :: bundle
type(ESMF_Grid) :: grid
type(ESMF_DataCopy_Flag), intent(in), optional :: datacopyflag
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farray1
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farray2
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farray3
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: farray4
logical, intent(in), optional :: do_slicing
logical, intent(in), optional :: do_slicing1
integer, intent(out), optional :: rc

Source Code

    subroutine assemble_bundle(bundle, grid, datacopyflag, farray1, farray2, farray3, farray4, do_slicing, do_slicing1, rc)

        type(ESMF_FieldBundle)   :: bundle
        type(ESMF_Grid)     :: grid
        type(ESMF_DataCopy_Flag), optional, intent(in)   :: datacopyflag
        real(ESMF_KIND_R4), dimension(:,:), pointer :: farray1
        real(ESMF_KIND_R4), dimension(:,:), pointer :: farray2
        real(ESMF_KIND_R4), dimension(:,:), pointer :: farray3
        real(ESMF_KIND_R4), dimension(:,:), pointer :: farray4
        logical, optional, intent(in)               :: do_slicing
        logical, optional, intent(in)               :: do_slicing1
        integer, optional, intent(out)   :: rc

        type(ESMF_Field)    :: f1, f2, f3, f4, f5
        type(ESMF_DistGrid) :: distgrid
        integer           :: i, j, localrc
        logical           :: ldo_slicing = .false.
        logical           :: ldo_slicing1 = .false.

        rc = ESMF_SUCCESS
        localrc = ESMF_SUCCESS

        if(present(do_slicing)) ldo_slicing = do_slicing
        if(present(do_slicing1)) ldo_slicing1 = do_slicing1

        call ESMF_GridGet(grid, distgrid=distgrid, rc=localrc)
        if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return

        allocate(farray1(5,10))
        allocate(farray2(5,10))
        allocate(farray3(5,20))
        allocate(farray4(10,20))

        do i = 1, 5
            do j = 1, 10
                farray1(i, j) = i + j * 2
                farray2(i, j) = i + j * 3
                farray3(i, j) = i + j * 4
                farray3(i, j+10) = i + (j+10) * 4
            enddo
        enddo
        do i = 1, 10
            do j = 1, 20
                farray4(i, j) = i + j * 5
            enddo
        enddo

        f1 = ESMF_FieldCreate(grid, farray1, ESMF_INDEX_DELOCAL, &
               datacopyflag=datacopyflag, name='field1', rc=localrc)
        if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_FieldBundleAdd(bundle, (/f1/), rc=localrc)
        if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return

        f2 = ESMF_FieldCreate(grid, farray2(:,:), ESMF_INDEX_DELOCAL, &
               datacopyflag=datacopyflag, name='field2', rc=localrc)
        if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return

        call ESMF_FieldBundleAdd(bundle, (/f2/), rc=localrc)
        if (ESMF_LogFoundError(localrc, &
                ESMF_ERR_PASSTHRU, &
                ESMF_CONTEXT, rcToReturn=rc)) return

        if(ldo_slicing) then

            f3 = ESMF_FieldCreate(grid, farray3(:, 4:13), ESMF_INDEX_DELOCAL, &
                   datacopyflag=datacopyflag, name='field3', rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return

            call ESMF_FieldBundleAdd(bundle, (/f3/), rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return
        endif

        if(ldo_slicing1) then
            f4 = ESMF_FieldCreate(grid, farray4(3:7, 4:13), ESMF_INDEX_DELOCAL, &
                   datacopyflag=datacopyflag, name='field4', rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return

            call ESMF_FieldBundleAdd(bundle, (/f4/), rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return

            f5 = ESMF_FieldCreate(grid, farray4(3:7, ::2), ESMF_INDEX_DELOCAL, &
                   datacopyflag=datacopyflag, name='field5', rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return

            call ESMF_FieldBundleAdd(bundle, (/f5/), rc=localrc)
            if (ESMF_LogFoundError(localrc, &
                    ESMF_ERR_PASSTHRU, &
                    ESMF_CONTEXT, rcToReturn=rc)) return
        endif
        
    end subroutine assemble_bundle