test5 Subroutine

subroutine test5(rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(out) :: rc

Source Code

  subroutine test5(rc)
    integer, intent(out)                :: rc
    integer                             :: localrc, i, npet
    type(ESMF_XGrid)                    :: xgrid
    type(ESMF_Grid)                     :: sideA(2), sideB(1)

    type(ESMF_VM)                       :: vm
    real(ESMF_KIND_R8)                  :: xgrid_area(12), B_area(2,2)
    type(ESMF_RouteHandle)              :: rh_src2xgrid(2), rh_xgrid2dst(1)

    type(ESMF_Mesh)                     :: mesh
    type(ESMF_Field)                    :: field1, field2
    type(ESMF_RouteHandle)              :: rh

    rc = ESMF_SUCCESS
    localrc = ESMF_SUCCESS

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

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

    ! Sew mesh
    ! right, left
    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,2,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,2,0.5,1.,4.,0.,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,0.7,0.7,0.,0.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! up, down
    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,4,0.5,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,4,1.,1.,0.,-4.,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,1.,1.,0.,-4.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! partially overlap
    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,4,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,4,0.6,1.,3.5,3.5,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,1.,1.,0.,0.,rc=localrc)/), &
      storeOverlay = .true., &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    call flux_exchange_sph(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,4,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,4,0.6,1.,2.9,3.5,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,1.,1.,0.,0.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    call flux_exchange_sph(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,4,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,4,0.6,1.,2.9,2.5,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,1.,1.,0.,0.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    call flux_exchange_sph(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,4,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(8,4,0.6,1.,1.9,1.5,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,1.,1.,0.,0.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    ! partially overlap subject bigger cell
    xgrid = ESMF_XGridCreate(sideAGrid=(/ &
        make_grid_sph(4,4,0.5,1.,2.8,1.4,rc=localrc), &
        make_grid_sph(4,4,1.,1.,0.,0.,rc=localrc) &
      /), &
      sideBGrid=(/make_grid_sph(30,30,0.3,0.3,0.,0.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    call flux_exchange_sph(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid= &
      (/make_grid_sph(30,30,0.3,0.3,0.,0.,rc=localrc)/), &
      sideBGrid=(/ &
        make_grid_sph(4,4,0.5,1.,2.8,1.4,rc=localrc), &
        make_grid_sph(4,4,1.,1.,0.,0.,rc=localrc) &
      /), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call flux_exchange_sph(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    if(npet == 1) then
    ! complicated merging
    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,2,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,2,0.5,1.,4.,0.,rc=localrc), &
                               make_grid_sph(4,2,1.,1.,6.,0.,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,0.7,0.7,0.,0.,rc=localrc), &
        make_grid_sph(8,8,0.7,0.7,0.,5.6,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,2,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,2,0.5,1.,3.,0.3,rc=localrc), &
                               make_grid_sph(4,4,1.,1.,-2.,-2.,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,0.7,0.7,0.,0.,rc=localrc), &
        make_grid_sph(8,8,0.7,0.7,0.,5.6,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid=&
      (/make_grid_sph(8,8,0.7,0.7,0.,0.,rc=localrc), &
        make_grid_sph(8,8,0.7,0.7,0.,5.6,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(4,2,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,2,0.5,1.,3.,0.3,rc=localrc), &
                               make_grid_sph(4,4,1.,1.,-2.,-2.,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    xgrid = ESMF_XGridCreate(sideAGrid=(/make_grid_sph(4,2,1.,1.,0.,0.,rc=localrc), &
        make_grid_sph(4,2,0.5,1.,3.,0.3,rc=localrc), &
                               make_grid_sph(4,4,1.,1.,-2.,-2.,rc=localrc)/), &
      sideBGrid=(/make_grid_sph(8,8,0.7,0.7,0.,0.,rc=localrc), &
        make_grid_sph(8,8,0.5,0.7,0.9,3.6,rc=localrc)/), &
      rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return
    call ESMF_XGridDestroy(xgrid, rc=localrc)
    if (ESMF_LogFoundError(localrc, &
      ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return

    endif

  end subroutine test5