Skip to content

Commit f2af6a5

Browse files
bena-nasabena-nasa
committed
remove rescriction on netcdf for any layout
1 parent f8235e0 commit f2af6a5

File tree

1 file changed

+21
-117
lines changed

1 file changed

+21
-117
lines changed

‎fv_regrid_c2c.F90‎

Lines changed: 21 additions & 117 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
#include "MAPL_ErrLog.h"
12
module fv_regrid_c2c
23

34
#ifdef MAPL_MODE
@@ -346,13 +347,15 @@ subroutine get_geos_cubed_ic( Atm, extra_rst, gridOut )
346347
endif
347348
call print_memuse_stats('get_geos_cubed_ic: '//TRIM(fname1)//' being read')
348349
offset = 4
349-
call parallel_read_file_r4(fname1, npts, is_i,ie_i, js_i,je_i, 1, offset, gz0(is_i:ie_i,js_i:je_i))
350+
call read_topo_file(fname1,gz0,gridIn)
351+
!call parallel_read_file_r4(fname1, npts, is_i,ie_i, js_i,je_i, 1, offset, gz0(is_i:ie_i,js_i:je_i))
350352
call mpp_update_domains(gz0, domain_i)
351353
gz0 = gz0*grav
352354

353355
! Read cubed-sphere phis from file since IMPORT is not ready yet
354356
offset = 4
355-
call parallel_read_file_r4('topo_dynave.data', Atm(1)%npx-1, is,ie, js,je, 1, offset, Atm(1)%phis(is:ie,js:je))
357+
!call parallel_read_file_r4('topo_dynave.data', Atm(1)%npx-1, is,ie, js,je, 1, offset, Atm(1)%phis(is:ie,js:je))
358+
call read_topo_file('topo_dynave.data',atm(1)%phis,gridOut)
356359
call mpp_update_domains(Atm(1)%phis, Atm(1)%domain)
357360
Atm(1)%phis = Atm(1)%phis*grav
358361
call print_memuse_stats('get_geos_cubed_ic: phis')
@@ -1878,121 +1881,22 @@ end subroutine mpp_domain_decomp
18781881
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
18791882
!-------------------------------------------------------------------------------
18801883

1881-
subroutine parallel_read_file_r8(fname, npts, is,ie, js,je, km, offset, var)
1882-
character(len=*), intent(IN) :: fname
1883-
integer, intent(IN) :: npts, is,ie, js,je, km
1884-
integer (kind=MPI_OFFSET_KIND), intent(INOUT) :: offset
1885-
real(FVPRC), intent(INOUT) :: var(is:ie, js:je, km)
1886-
1887-
integer :: ntiles=6
1888-
real(REAL64) :: var_r8(is:ie, js:je)
1889-
integer :: k
1890-
1891-
integer :: MUNIT=17
1892-
integer :: lsize, gsizes(2), distribs(2), dargs(2), psizes(2)
1893-
integer :: filetype
1894-
integer :: mcol, mrow, irow, jcol, mpiio_rank
1895-
integer :: rank, total_pes
1896-
integer :: mpistatus(MPI_STATUS_SIZE)
1897-
integer (kind=MPI_OFFSET_KIND) :: slice_2d
1898-
1899-
real(FVPRC) :: xmod, ymod
1900-
character(128) :: strErr
1901-
1902-
xmod = mod(npts,npes_x)
1903-
write(strErr, "(i4.4,' not evenly divisible by ',i4.4)") npts, npes_x
1904-
if (xmod /= 0) call mpp_error(FATAL, strErr)
1905-
ymod = mod(npts*6,npes_y)
1906-
write(strErr, "(i4.4,' not evenly divisible by ',i4.4)") npts*6, npes_y
1907-
if (ymod /= 0) call mpp_error(FATAL, strErr)
1908-
1909-
call MPI_FILE_OPEN(MPI_COMM_WORLD, fname, MPI_MODE_RDONLY, MPI_INFO_NULL, MUNIT, STATUS)
1910-
gsizes(1) = npts
1911-
gsizes(2) = npts * 6
1912-
distribs(1) = MPI_DISTRIBUTE_BLOCK
1913-
distribs(2) = MPI_DISTRIBUTE_BLOCK
1914-
dargs(1) = MPI_DISTRIBUTE_DFLT_DARG
1915-
dargs(2) = MPI_DISTRIBUTE_DFLT_DARG
1916-
psizes(1) = npes_x
1917-
psizes(2) = npes_y * 6
1918-
call MPI_COMM_SIZE(MPI_COMM_WORLD, total_pes, STATUS)
1919-
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, STATUS)
1920-
mcol = npes_x
1921-
mrow = npes_y*ntiles
1922-
irow = rank/mcol !! logical row number
1923-
jcol = mod(rank, mcol) !! logical column number
1924-
mpiio_rank = jcol*mrow + irow
1925-
call MPI_TYPE_CREATE_DARRAY(total_pes, mpiio_rank, 2, gsizes, distribs, dargs, psizes, MPI_ORDER_FORTRAN, MPI_DOUBLE_PRECISION, filetype, STATUS)
1926-
call MPI_TYPE_COMMIT(filetype, STATUS)
1927-
lsize = (ie-is+1)*(je-js+1)
1928-
slice_2d = npts*npts*ntiles
1929-
do k=1,km
1930-
call MPI_FILE_SET_VIEW(MUNIT, offset, MPI_DOUBLE_PRECISION, filetype, "native", MPI_INFO_NULL, STATUS)
1931-
call MPI_FILE_READ_ALL(MUNIT, var_r8, lsize, MPI_DOUBLE_PRECISION, mpistatus, STATUS)
1932-
var(:,:,k) = var_r8
1933-
offset = offset + slice_2d*8 + 8
1934-
enddo
1935-
call MPI_FILE_CLOSE(MUNIT, STATUS)
1936-
1937-
end subroutine parallel_read_file_r8
1938-
1939-
subroutine parallel_read_file_r4(fname, npts, is,ie, js,je, km, offset, var)
1940-
character(len=*), intent(IN) :: fname
1941-
integer, intent(IN) :: npts, is,ie, js,je, km
1942-
integer (kind=MPI_OFFSET_KIND), intent(INOUT) :: offset
1943-
real(FVPRC), intent(INOUT) :: var(is:ie, js:je, km)
1944-
1945-
integer :: ntiles=6
1946-
real(REAL4) :: var_r4(is:ie, js:je)
1947-
integer :: k
1948-
1949-
integer :: MUNIT=17
1950-
integer :: lsize, gsizes(2), distribs(2), dargs(2), psizes(2)
1951-
integer :: filetype
1952-
integer :: mcol, mrow, irow, jcol, mpiio_rank
1953-
integer :: rank, total_pes
1954-
integer :: mpistatus(MPI_STATUS_SIZE)
1955-
integer (kind=MPI_OFFSET_KIND) :: slice_2d
1956-
1957-
real(FVPRC) :: xmod, ymod
1958-
character(128) :: strErr
1959-
1960-
xmod = mod(npts,npes_x)
1961-
write(strErr, "(i4.4,' not evenly divisible by ',i4.4)") npts, npes_x
1962-
if (xmod /= 0) call mpp_error(FATAL, strErr)
1963-
ymod = mod(npts*6,npes_y)
1964-
write(strErr, "(i4.4,' not evenly divisible by ',i4.4)") npts*6, npes_y
1965-
if (ymod /= 0) call mpp_error(FATAL, strErr)
1966-
1967-
call MPI_FILE_OPEN(MPI_COMM_WORLD, fname, MPI_MODE_RDONLY, MPI_INFO_NULL, MUNIT, STATUS)
1968-
gsizes(1) = npts
1969-
gsizes(2) = npts * 6
1970-
distribs(1) = MPI_DISTRIBUTE_BLOCK
1971-
distribs(2) = MPI_DISTRIBUTE_BLOCK
1972-
dargs(1) = MPI_DISTRIBUTE_DFLT_DARG
1973-
dargs(2) = MPI_DISTRIBUTE_DFLT_DARG
1974-
psizes(1) = npes_x
1975-
psizes(2) = npes_y * 6
1976-
call MPI_COMM_SIZE(MPI_COMM_WORLD, total_pes, STATUS)
1977-
call MPI_COMM_RANK(MPI_COMM_WORLD, rank, STATUS)
1978-
mcol = npes_x
1979-
mrow = npes_y*ntiles
1980-
irow = rank/mcol !! logical row number
1981-
jcol = mod(rank, mcol) !! logical column number
1982-
mpiio_rank = jcol*mrow + irow
1983-
call MPI_TYPE_CREATE_DARRAY(total_pes, mpiio_rank, 2, gsizes, distribs, dargs, psizes, MPI_ORDER_FORTRAN, MPI_REAL, filetype, STATUS)
1984-
call MPI_TYPE_COMMIT(filetype, STATUS)
1985-
lsize = (ie-is+1)*(je-js+1)
1986-
slice_2d = npts*npts*ntiles
1987-
do k=1,km
1988-
call MPI_FILE_SET_VIEW(MUNIT, offset, MPI_REAL, filetype, "native", MPI_INFO_NULL, STATUS)
1989-
call MPI_FILE_READ_ALL(MUNIT, var_r4, lsize, MPI_REAL, mpistatus, STATUS)
1990-
var(:,:,k) = var_r4
1991-
offset = offset + slice_2d*4 + 8
1992-
enddo
1993-
call MPI_FILE_CLOSE(MUNIT, STATUS)
1994-
1995-
end subroutine parallel_read_file_r4
1884+
subroutine read_topo_file(fname,output,grid,rc)
1885+
character(len=*), intent(in) :: fname
1886+
type(ESMF_Grid), intent(in) :: grid
1887+
real(real4), intent(inout) :: output(:,:)
1888+
integer, intent(out), optional :: rc
1889+
1890+
integer :: status,dims(3),funit
1891+
real, allocatable :: input(:,:)
1892+
call MAPL_GridGet(grid,globalCellCountPerDim=dims,_RC)
1893+
allocate(input(dims(1),dims(2)))
1894+
open(newunit=funit,file=trim(fname),form='unformatted',iostat=status)
1895+
_VERIFY(status)
1896+
read(funit)input
1897+
call ArrayScatter(local_array=output,global_array=input,grid=grid,_RC)
1898+
_RETURN(_SUCCESS)
1899+
end subroutine read_topo_file
19961900

19971901
end module fv_regrid_c2c
19981902

0 commit comments

Comments
 (0)