Merge pull request NOAA-GFDL#24 from GEOS-ESM/geos/develop

Merge Geos/develop into MAPL 2.0

CMakeLists.txt

@@ -81,4 +81,6 @@ endif()
 
 target_compile_definitions (${this} PRIVATE MAPL_MODE SPMD TIMING)
 
-esma_add_subdirectories(model/mapz-driver)
+esma_add_subdirectories(
+  model/mapz-driver
+  model/tp-core-driver)

model/tp-core-driver/CMakeLists.txt

@@ -0,0 +1,17 @@
+esma_set_this()
+
+set(srcs
+  ../tp_core.F90
+  stubs/fv_mp_mod_stub.F90
+  stubs/fv_grid_utils_stub.F90
+  stubs/fv_arrays_stub.F90
+  input/input_arrays.f90
+  output/output_arrays.f90
+  driver_cpu.f90
+  main.f90)
+
+ecbuild_add_executable(
+  TARGET tp-core-driver
+  SOURCES ${srcs})
+target_compile_options(tp-core-driver PRIVATE ${TRACEBACK})
+set_target_properties(${this} PROPERTIES Fortran_MODULE_DIRECTORY ${esma_include}/${this})

model/tp-core-driver/driver_cpu.f90

@@ -0,0 +1,90 @@
+module driver_cpu_mod
+
+  use tp_core_mod, only: fv_tp_2d
+  use fv_arrays_mod, only: fv_grid_bounds_type, fv_grid_type
+  use input_arrays_mod, only: InputArrays_T
+  use output_arrays_mod, only: OutputArrays_T
+
+  implicit none
+
+  private
+
+  public run_driver
+
+  integer, parameter :: hord = 8
+  real, parameter :: lim_fac = 1.0
+
+contains
+
+  subroutine run_driver() bind(C, name='run_driver')
+
+    ! Locals
+    type(fv_grid_bounds_type) :: bd
+    type(fv_grid_type) :: gridstruct
+    type(InputArrays_T) :: in_arrays
+    type(OutputArrays_T) :: out_arrays
+    integer :: npx, npy
+    integer :: iter
+    real :: start, finish
+    integer :: n, n_iterations
+
+    ! Get resolution and number of iterations
+    call get_cmdline_args_(n, n_iterations)
+
+    ! Initialize
+    bd = fv_grid_bounds_type(n)
+    npx = n + 1; npy = n + 1
+    gridstruct = fv_grid_type(bd, npx, npy, .false., 0)
+    in_arrays = InputArrays_T(bd, npx, npy, gridstruct)
+    out_arrays = OutputArrays_T(bd)
+
+    ! Run fv_tp_2d
+    call cpu_time(start)
+    do iter = 1, n_iterations
+       call fv_tp_2d( &
+            in_arrays%q, in_arrays%crx, in_arrays%cry, &
+            npx, npy, hord, &
+            out_arrays%fx, out_arrays%fy, &
+            in_arrays%xfx, in_arrays%yfx, &
+            gridstruct, bd, &
+            in_arrays%ra_x, in_arrays%ra_y, &
+            lim_fac)
+    end do
+    call cpu_time(finish)
+
+    print *, 'time taken: ', finish - start, 's'
+    print *, 'sum(fx): ', sum(out_arrays%fx), ', sum(fy): ', sum(out_arrays%fy)
+
+  end subroutine run_driver
+
+  subroutine usage(program_name)
+
+    ! Arguments
+    character(len=256) :: program_name
+
+    print *, 'Usage: ', trim(program_name), ' <resolution> <number-of-iterations>'
+
+  end subroutine usage
+
+  subroutine get_cmdline_args_(resolution, n_iterations)
+
+    ! Arguments
+    integer, intent(out) :: resolution
+    integer, intent(out) :: n_iterations
+    ! Local
+    integer :: argc
+    character(len=256) :: program_name, res_char, niter_char
+
+    call get_command_argument(0, program_name)
+    argc = command_argument_count()
+    if (2 /= argc) then
+       call usage(program_name)
+       error stop ' ERROR: cmdline argument count is incorrect'
+    end if
+    call get_command_argument(1, res_char); read(res_char, *) resolution
+    call get_command_argument(2, niter_char); read(niter_char, *) n_iterations
+
+
+  end subroutine get_cmdline_args_
+
+end module driver_cpu_mod

model/tp-core-driver/input/input_arrays.f90

@@ -0,0 +1,102 @@
+module input_arrays_mod
+
+  use fv_arrays_mod, only: fv_grid_bounds_type, fv_grid_type
+
+  implicit none
+
+  private
+
+  public InputArrays_T
+
+  type InputArrays_T
+     real, allocatable :: q(:, :)
+     real, allocatable :: crx(:, :), cry(:, :)
+     real, allocatable :: xfx(:, :), yfx(:, :)
+     real, allocatable :: ra_x(:, :), ra_y(:, :)
+  end type InputArrays_T
+
+  interface InputArrays_T
+     procedure :: input_arrays_initialize_
+  end interface InputArrays_T
+
+contains
+
+  function input_arrays_initialize_(bd, npx, npy, gridstruct) result(arrays)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    integer, intent(in) :: npx, npy
+    type(fv_grid_type), intent(in) :: gridstruct
+    type(InputArrays_T) :: arrays ! output
+    ! Locals
+    integer :: i, j
+
+    call initialize_q_(bd, npx, npy, arrays%q)
+    allocate(arrays%crx(bd%is:bd%ie+1, bd%jsd:bd%jed), source = 0.5)
+    allocate(arrays%cry(bd%isd:bd%ied, bd%js:bd%je+1), source = 0.5)
+    allocate(arrays%xfx(bd%is:bd%ie+1, bd%jsd:bd%jed), source = 0.5)
+    allocate(arrays%yfx(bd%isd:bd%ied, bd%js:bd%je+1), source = 0.5)
+    call initialize_ra_x_(bd, gridstruct%area, arrays%xfx, arrays%ra_x)
+    call initialize_ra_y_(bd, gridstruct%area, arrays%yfx, arrays%ra_y)
+
+  end function input_arrays_initialize_
+
+  subroutine initialize_q_(bd, npx, npy, q)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    integer, intent(in) :: npx, npy
+    real, allocatable, intent(out) :: q(:,:)
+    ! Locals
+    integer :: j, i
+
+    allocate(q(bd%isd:bd%ied, bd%jsd:bd%jed))
+    do j = bd%jsd, bd%jed
+       do i = bd%isd, bd%ied
+          q(i,j) = sin(3.1415927 * float(i*j) / float( (npx-1) * (npy-1) ) )
+       end do
+    end do
+
+  end subroutine initialize_q_
+
+  subroutine initialize_ra_x_(bd, area, xfx, ra_x)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    real, intent(in) :: area(:,:)
+    real, intent(in) :: xfx(:,:)
+    real, allocatable, intent(out) :: ra_x(:,:)
+    ! Locals
+    integer :: j, i
+
+    allocate(ra_x(bd%is:bd%ie, bd%jsd:bd%jed))
+    ! do j = bd%jsd, bd%jed
+    !    do i = bd%is, bd%ie
+    !       ra_x(i,j) = area(i,j) + (xfx(i,j) - xfx(i+1,j))
+    !    end do
+    ! end do
+    ra_x = 1.0
+
+  end subroutine initialize_ra_x_
+
+  subroutine initialize_ra_y_(bd, area, yfx, ra_y)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    real, intent(in) :: area(:,:)
+    real, intent(in) :: yfx(:,:)
+    real, allocatable, intent(out) :: ra_y(:,:)
+    ! Locals
+    integer :: j, i
+
+    allocate(ra_y(bd%isd:bd%ied, bd%js:bd%je))
+    ! do j = bd%js, bd%je
+    !    do i = bd%isd, bd%ied
+    !       ra_y(i,j) = area(i,j) + (yfx(i,j) - yfx(i,j+1))
+    !    end do
+    ! end do
+    ra_y = 1.0
+
+  end subroutine initialize_ra_y_
+
+end module input_arrays_mod

model/tp-core-driver/main.f90

@@ -0,0 +1,9 @@
+program main
+
+  use driver_cpu_mod, only: run_driver
+
+  implicit none
+
+  call run_driver()
+
+end program main

model/tp-core-driver/output/output_arrays.f90

@@ -0,0 +1,34 @@
+module output_arrays_mod
+
+  use fv_arrays_mod, only: fv_grid_bounds_type
+
+  implicit none
+
+  private
+
+  public OutputArrays_T
+
+  type OutputArrays_T
+     real, allocatable :: fx(:, :) ! flux in x (E)
+     real, allocatable :: fy(:, :) ! flux in y (N)
+  end type OutputArrays_T
+
+  interface OutputArrays_T
+     procedure :: output_arrays_allocate_mem_
+  end interface OutputArrays_T
+
+contains
+
+  function output_arrays_allocate_mem_(bd) result(arrays)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    type(OutputArrays_T) :: arrays ! output
+
+    ! Start
+    allocate(arrays%fx(bd%is:bd%ie+1, bd%js:bd%je))
+    allocate(arrays%fy(bd%is:bd%ie, bd%js:bd%je+1))
+
+  end function output_arrays_allocate_mem_
+
+end module output_arrays_mod

model/tp-core-driver/stubs/fv_arrays_stub.F90

@@ -0,0 +1,103 @@
+module fv_arrays_mod
+
+  use fv_mp_mod, only: halo_size => ng
+
+  implicit none
+
+  public fv_grid_type, fv_grid_bounds_type
+
+  private
+
+  integer, parameter :: R_GRID = 8
+
+  type fv_grid_type
+     logical, pointer :: nested
+     integer, pointer :: grid_type
+     logical:: sw_corner, se_corner, ne_corner, nw_corner
+     real, allocatable, dimension(:,:) :: dxa, dya
+     real, allocatable, dimension(:,:) :: area
+     ! rarea, del6_u/v are used in subroutine deln_flux which is called
+     ! if some of the optional arguments mfx, mfy, damp_c and mass are present
+     real, allocatable, dimension(:,:) :: rarea ! NOT INITIALIZED AT THE MOMENT
+     real, allocatable :: del6_u(:,:), del6_v(:,:) ! NOT INITIALIZED AT THE MOMENT
+     ! da_min is used in fv_tp_2d if damp_c and mass are present
+     real(kind=R_GRID) :: da_min ! NOT INITIALIZED AT THE MOMENT
+  end type fv_grid_type
+
+  interface fv_grid_type
+     procedure fv_grid_type_initialize ! constructor
+  end interface fv_grid_type
+
+  type fv_grid_bounds_type
+     integer :: is,  ie,  js,  je
+     integer :: isd, ied, jsd, jed
+  end type fv_grid_bounds_type
+
+  interface fv_grid_bounds_type
+     procedure fv_grid_bounds_type_initialize ! constructor
+  end interface fv_grid_bounds_type
+
+contains
+
+  function fv_grid_bounds_type_initialize(n) result(bd)
+
+    ! Arguments
+    integer, intent(in) :: n
+    type(fv_grid_bounds_type) :: bd ! output
+
+    ! Start
+    bd%is = 1
+    bd%ie = n
+    bd%isd = bd%is - halo_size
+    bd%ied = bd%ie + halo_size
+
+    bd%js = 1
+    bd%je = n
+    bd%jsd = bd%js - halo_size
+    bd%jed = bd%je + halo_size
+
+  end function fv_grid_bounds_type_initialize
+
+  function fv_grid_type_initialize(bd, npx, npy, nested, grid_type) result(gridstruct)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    integer, intent(in) :: npx, npy
+    logical, intent(in), target :: nested
+    integer, intent(in), target :: grid_type
+    type(fv_grid_type) :: gridstruct ! output
+
+    ! NOTE: We are NOT initializing rarea, del6_u/v, da_min
+    ! These variables are used if some of the optional arguments (mfx, mfy,
+    ! damp_c, mass) to fv_tp_2d are present. At the moment, for the purpose of
+    ! top_core driver, we are not passing the optional arguments
+
+    ! Start
+    gridstruct%grid_type => grid_type
+    gridstruct%nested => nested
+
+    call initialize_corners_(bd, npx, npy, gridstruct)
+    allocate(gridstruct%dxa(bd%isd:bd%ied, bd%jsd:bd%jed), source = 1.0)
+    allocate(gridstruct%dya(bd%isd:bd%ied, bd%jsd:bd%jed), source = 1.0)
+    allocate(gridstruct%area(bd%isd:bd%ied, bd%jsd:bd%jed), source = 1.0)
+
+  end function fv_grid_type_initialize
+
+  subroutine initialize_corners_(bd, npx, npy, gridstruct)
+
+    ! Arguments
+    type(fv_grid_bounds_type), intent(in) :: bd
+    integer, intent(in) :: npx, npy
+    type(fv_grid_type), intent(inout) :: gridstruct
+
+    ! Start
+    if ( (gridstruct%grid_type < 3) .and. (.not. gridstruct%nested) ) then
+       if ( bd%is==1 .and. bd%js==1 ) gridstruct%sw_corner = .true.
+       if ( (bd%ie+1)==npx .and. bd%js==1 ) gridstruct%se_corner = .true.
+       if ( (bd%ie+1)==npx .and. (bd%je+1)==npy ) gridstruct%ne_corner = .true.
+       if (     bd%is==1   .and. (bd%je+1)==npy ) gridstruct%nw_corner = .true.
+    endif
+
+  end subroutine initialize_corners_
+
+end module fv_arrays_mod