subroutine retrieve_bundle_dataptr(bundle, datacopyflag, do_slicing, do_slicing1, rc)
type(ESMF_FieldBundle) :: bundle
type(ESMF_DataCopy_Flag), optional, intent(in) :: datacopyflag
logical, optional, intent(in) :: do_slicing
logical, optional, intent(in) :: do_slicing1
integer, optional :: rc
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
real(ESMF_KIND_R4), dimension(:,:), pointer :: farray5
type(ESMF_Field) :: f1, f2, f3, f4, f5
integer :: fc, 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_FieldBundleGet(bundle, 'field1', field=f1, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(f1, localDe=0, farrayPtr=farray1, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldBundleGet(bundle, 'field2', field=f2, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(f2, localDe=0, farrayPtr=farray2, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i = 1, 5
do j = 1, 10
if( farray1(i, j) .ne. i + j * 2) localrc = ESMF_FAILURE
enddo
enddo
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i = 1, 5
do j = 1, 10
if( farray2(i, j) .ne. i + j * 3) localrc = ESMF_FAILURE
enddo
enddo
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(ldo_slicing) then
! test field3 created from farray3 :, 4:13
! contiguous slice -> will work in DATA_REF and DATA_COPY mode
call ESMF_FieldBundleGet(bundle, 'field3', field=f3, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(f3, localDe=0, farrayPtr=farray3, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i = 1, 5
do j = 1, 10
if( farray3(i, j) .ne. i + (j+3) * 4) localrc = ESMF_FAILURE
enddo
enddo
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
if(ldo_slicing1) then
! test field4 created from farray4 3:7, 4:13
! discontiguous slice -> DATA_COPY will work, DATA_REF will not work
call ESMF_FieldBundleGet(bundle, 'field4', field=f4, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(f4, localDe=0, farrayPtr=farray4, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i = 1, 5
do j = 1, 10
write(*, *) 'line 400: farray4: ', i, j, farray4(i,j), i + 2 + (j+3) * 5
if( farray4(i, j) .ne. i + 2 + (j+3) * 5) localrc = ESMF_FAILURE
enddo
enddo
if (present(datacopyflag)) then
if (datacopyflag.eq.ESMF_DATACOPY_VALUE) then
! only DATA_COPY is expected to work correctly
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) continue
rc = ESMF_SUCCESS ! reset
end if
else
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) continue
rc = ESMF_SUCCESS ! reset
endif
! test field5 created from farray4 3:7, ::2
! discontiguous slice -> DATA_COPY will work, DATA_REF will not work
call ESMF_FieldBundleGet(bundle, 'field5', field=f5, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(f5, localDe=0, farrayPtr=farray5, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
do i = 1, 5
do j = 1, 10
write(*, *) 'line 436: farray5: ', i, j, farray5(i,j), i + 2 + (j*2-1) * 5
if( farray5(i, j) .ne. i + 2 + (j*2-1) * 5) localrc = ESMF_FAILURE
enddo
enddo
if (present(datacopyflag)) then
if (datacopyflag.eq.ESMF_DATACOPY_VALUE) then
! only DATA_COPY is expected to work correctly
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) continue
rc = ESMF_SUCCESS ! reset
end if
else
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) continue
rc = ESMF_SUCCESS ! reset
endif
endif
call ESMF_FieldBundleGet(bundle, fieldcount=fc, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
end subroutine retrieve_bundle_dataptr