init_src_sph Subroutine

subroutine init_src_sph(grid, coordX, coordY, nx, ny, dx, dy, src, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Grid), intent(in) :: grid
real(kind=ESMF_KIND_R8), pointer :: coordX(:,:)
real(kind=ESMF_KIND_R8), pointer :: coordY(:,:)
integer, intent(in) :: nx
integer, intent(in) :: ny
real, intent(in) :: dx
real, intent(in) :: dy
real(kind=ESMF_KIND_R8), pointer :: src(:,:)
integer, intent(out), optional :: rc

Source Code

  subroutine init_src_sph(grid, coordX, coordY, nx, ny, dx, dy, src, rc)
    type(ESMF_Grid), intent(in)      :: grid
    real(ESMF_KIND_R8), pointer      :: coordX(:,:)
    real(ESMF_KIND_R8), pointer      :: coordY(:,:)
    integer, intent(in)              :: nx, ny
    real, intent(in)                 :: dx, dy
    real(ESMF_KIND_R8), pointer      :: src(:,:)
    integer, intent(out), optional   :: rc

    integer                          :: localrc, i,j,npet, lpet
    type(ESMF_VM)                    :: vm

    if(present(rc)) rc = ESMF_SUCCESS

    call ESMF_VMGetCurrent(vm, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return

    call ESMF_VMGet(vm, petCount=npet, localPet=lpet, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return

    ! X center 
    call ESMF_GridGetCoord(grid, localDE=0, &
        staggerLoc=ESMF_STAGGERLOC_CENTER, &
        coordDim=1, farrayPtr=coordX, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return
    ! Y center 
    call ESMF_GridGetCoord(grid, localDE=0, &
        staggerLoc=ESMF_STAGGERLOC_CENTER, &
        coordDim=2, farrayPtr=coordY, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
        ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return

    write(*, '(A, 5I5)') 'init_src_sph bounds: ', lpet, &
      lbound(src, 1), ubound(src, 1), &
      lbound(src, 2), ubound(src, 2)

    do i = lbound(coordX,1), ubound(coordX,1)
      do j = lbound(coordX,2), ubound(coordX,2)
        !src(i,j) = 0.5*sin(coordX(i,j)/(nx*dx)*3*3.14159)*cos(coordY(i,j)&
        !/(ny*dy)*5*3.14159)+10.5
        src(i,j) = 2.
      enddo
    enddo

  end subroutine init_src_sph