Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Mixed precision data_override_mod #1323

Merged
merged 25 commits into from
Aug 30, 2023
Merged
Show file tree
Hide file tree
Changes from 24 commits
Commits
Show all changes
25 commits
Select commit Hold shift + click to select a range
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 4 additions & 2 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -318,7 +318,8 @@ foreach(kind ${kinds})
field_manager/include
time_interp/include
tracer_manager/include
interpolator/include)
interpolator/include
data_override/include)

target_compile_definitions(${libTgt}_f PRIVATE "${fms_defs}")
target_compile_definitions(${libTgt}_f PRIVATE "${${kind}_defs}")
Expand Down Expand Up @@ -366,7 +367,8 @@ foreach(kind ${kinds})
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/diag_manager/include>
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/random_numbers/include>
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/tracer_manager/include>
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/interpolator/include>)
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/interpolator/include>
$<BUILD_INTERFACE:${CMAKE_CURRENT_SOURCE_DIR}/data_override/include>)


target_include_directories(${libTgt} INTERFACE
Expand Down
10 changes: 8 additions & 2 deletions data_override/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -23,16 +23,22 @@
# Ed Hartnett 2/22/19

# Include .h and .mod files.
AM_CPPFLAGS = -I$(top_srcdir)/include
AM_CPPFLAGS = -I$(top_srcdir)/include -I$(top_srcdir)/data_override/include
AM_FCFLAGS = $(FC_MODINC). $(FC_MODOUT)$(MODDIR)

# Build this uninstalled convenience library.
noinst_LTLIBRARIES = libdata_override.la

# The convenience library depends on its source.
libdata_override_la_SOURCES = \
get_grid_version.F90 \
include/get_grid_version_r4.fh \
include/get_grid_version_r8.fh \
include/get_grid_version.inc \
data_override.F90 \
get_grid_version.F90
include/data_override_r4.fh \
include/data_override_r8.fh \
include/data_override.inc

# Some mods are dependent on other mods in this dir.
data_override_mod.$(FC_MODEXT): get_grid_version_mod.$(FC_MODEXT)
Expand Down
1,331 changes: 120 additions & 1,211 deletions data_override/data_override.F90

Large diffs are not rendered by default.

242 changes: 14 additions & 228 deletions data_override/get_grid_version.F90
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,8 @@
!> @addtogroup get_grid_version_mod
!> @{
module get_grid_version_mod
use constants_mod, only: PI
use constants_mod, only: DEG_TO_RAD
use platform_mod, only: r4_kind, r8_kind
use mpp_mod, only : mpp_error,FATAL,NOTE, mpp_min, mpp_max
use mpp_domains_mod, only : domain2d, operator(.NE.),operator(.EQ.)
use mpp_domains_mod, only : mpp_get_global_domain, mpp_get_data_domain
Expand All @@ -33,7 +34,16 @@ module get_grid_version_mod

implicit none

real, parameter :: deg_to_radian=PI/180.
Copy link
Contributor

@mlee03 mlee03 Aug 30, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

is it a private variable?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It was, but I've replaced it with DEG_TO_RAD from constants_mod.

interface get_grid_version_1
module procedure get_grid_version_1_r4
module procedure get_grid_version_1_r8
end interface get_grid_version_1

interface get_grid_version_2
module procedure get_grid_version_2_r4
module procedure get_grid_version_2_r8
end interface get_grid_version_2

contains

!> Get lon and lat of three model (target) grids from grid_spec.nc
Expand All @@ -60,232 +70,8 @@ subroutine check_grid_sizes(domain_name, Domain, nlon, nlat)
endif
end subroutine check_grid_sizes

!> Get global lon and lat of three model (target) grids, with a given file name
subroutine get_grid_version_1(grid_file, mod_name, domain, isc, iec, jsc, jec, lon, lat, min_lon, max_lon)
character(len=*), intent(in) :: grid_file !< name of grid file
character(len=*), intent(in) :: mod_name !< module name
type(domain2d), intent(in) :: domain !< 2D domain
integer, intent(in) :: isc, iec, jsc, jec
real, dimension(isc:,jsc:), intent(out) :: lon, lat
real, intent(out) :: min_lon, max_lon

integer :: i, j, siz(4)
integer :: nlon, nlat !< size of global lon and lat
real, dimension(:,:,:), allocatable :: lon_vert, lat_vert !< of OCN grid vertices
real, dimension(:), allocatable :: glon, glat !< lon and lat of 1-D grid of atm/lnd
logical :: is_new_grid
integer :: is, ie, js, je
integer :: isd, ied, jsd, jed
integer :: isg, ieg, jsg, jeg
character(len=3) :: xname, yname
integer :: start(2), nread(2)
type(FmsNetcdfDomainFile_t) :: fileobj
integer :: ndims !< Number of dimensions

if(.not. open_file(fileobj, grid_file, 'read', domain )) then
call mpp_error(FATAL, 'data_override_mod(get_grid_version_1): Error in opening file '//trim(grid_file))
endif

call mpp_get_data_domain(domain, isd, ied, jsd, jed)
call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)

select case(mod_name)
case('ocn', 'ice')
is_new_grid = .FALSE.
if(variable_exists(fileobj, 'x_T')) then
is_new_grid = .true.
else if(variable_exists(fileobj, 'geolon_t')) then
is_new_grid = .FALSE.
else
call mpp_error(FATAL,'data_override: both x_T and geolon_t is not in the grid file '//trim(grid_file) )
endif

if(is_new_grid) then
ndims = get_variable_num_dimensions(fileobj, 'x_T')
call get_variable_size(fileobj, 'x_T', siz(1:ndims))
nlon = siz(1); nlat = siz(2)
call check_grid_sizes(trim(mod_name)//'_domain ', domain, nlon, nlat)
allocate(lon_vert(isc:iec,jsc:jec,4), lat_vert(isc:iec,jsc:jec,4) )

call read_data(fileobj, 'x_vert_T', lon_vert)
call read_data(fileobj, 'y_vert_T', lat_vert)

!2 Global lon and lat of ocean grid cell centers are determined from adjacent vertices
lon(:,:) = (lon_vert(:,:,1) + lon_vert(:,:,2) + lon_vert(:,:,3) + lon_vert(:,:,4))*0.25
lat(:,:) = (lat_vert(:,:,1) + lat_vert(:,:,2) + lat_vert(:,:,3) + lat_vert(:,:,4))*0.25
else

ndims = get_variable_num_dimensions(fileobj, 'geolon_vert_t')
call get_variable_size(fileobj, 'geolon_vert_t', siz(1:ndims))
nlon = siz(1) - 1; nlat = siz(2) - 1;
call check_grid_sizes(trim(mod_name)//'_domain ', domain, nlon, nlat)

start(1) = isc; nread(1) = iec-isc+2
start(2) = jsc; nread(2) = jec-jsc+2

allocate(lon_vert(isc:iec+1,jsc:jec+1,1))
allocate(lat_vert(isc:iec+1,jsc:jec+1,1))

call read_data(fileobj, 'geolon_vert_t', lon_vert(:,:,1), corner=start, edge_lengths=nread)
call read_data(fileobj, 'geolat_vert_t', lat_vert(:,:,1), corner=start, edge_lengths=nread)

do j = jsc, jec
do i = isc, iec
lon(i,j) = (lon_vert(i,j,1) + lon_vert(i+1,j,1) + &
lon_vert(i+1,j+1,1) + lon_vert(i,j+1,1))*0.25
lat(i,j) = (lat_vert(i,j,1) + lat_vert(i+1,j,1) + &
lat_vert(i+1,j+1,1) + lat_vert(i,j+1,1))*0.25
enddo
enddo
endif
deallocate(lon_vert)
deallocate(lat_vert)
case('atm', 'lnd')
if(trim(mod_name) == 'atm') then
xname = 'xta'; yname = 'yta'
else
xname = 'xtl'; yname = 'ytl'
endif
ndims = get_variable_num_dimensions(fileobj, xname)
call get_variable_size(fileobj, xname, siz(1:ndims))
nlon = siz(1); allocate(glon(nlon))
call read_data(fileobj, xname, glon)

ndims = get_variable_num_dimensions(fileobj, xname)
call get_variable_size(fileobj, yname, siz(1:ndims))
nlat = siz(1); allocate(glat(nlat))
call read_data(fileobj, yname, glat)
call check_grid_sizes(trim(mod_name)//'_domain ', domain, nlon, nlat)

is = isc - isg + 1; ie = iec - isg + 1
js = jsc - jsg + 1; je = jec - jsg + 1
do j = js, jec
do i = is, ie
lon(i,j) = glon(i)
lat(i,j) = glat(j)
enddo
enddo
deallocate(glon)
deallocate(glat)
case default
call mpp_error(FATAL, "data_override_mod: mod_name should be 'atm', 'ocn', 'ice' or 'lnd' ")
end select

call close_file(fileobj)

! convert from degree to radian
lon = lon * deg_to_radian
lat = lat* deg_to_radian
min_lon = minval(lon)
max_lon = maxval(lon)
call mpp_min(min_lon)
call mpp_max(max_lon)


end subroutine get_grid_version_1

!> Get global lon and lat of three model (target) grids from mosaic.nc.
!! Currently we assume the refinement ratio is 2 and there is one tile on each pe.
subroutine get_grid_version_2(fileobj, mod_name, domain, isc, iec, jsc, jec, lon, lat, min_lon, max_lon)
type(FmsNetcdfFile_t), intent(in) :: fileobj !< file object for grid file
character(len=*), intent(in) :: mod_name !< module name
type(domain2d), intent(in) :: domain !< 2D domain
integer, intent(in) :: isc, iec, jsc, jec
real, dimension(isc:,jsc:), intent(out) :: lon, lat
real, intent(out) :: min_lon, max_lon

integer :: i, j, siz(2)
integer :: nlon, nlat ! size of global grid
integer :: nlon_super, nlat_super ! size of global supergrid.
integer :: isd, ied, jsd, jed
integer :: isg, ieg, jsg, jeg
integer :: isc2, iec2, jsc2, jec2
character(len=256) :: solo_mosaic_file, grid_file
real, allocatable :: tmpx(:,:), tmpy(:,:)
logical :: open_solo_mosaic
type(FmsNetcdfFile_t) :: mosaicfileobj, tilefileobj
integer :: start(2), nread(2)

if(trim(mod_name) .NE. 'atm' .AND. trim(mod_name) .NE. 'ocn' .AND. &
trim(mod_name) .NE. 'ice' .AND. trim(mod_name) .NE. 'lnd' ) call mpp_error(FATAL, &
"data_override_mod: mod_name should be 'atm', 'ocn', 'ice' or 'lnd' ")

call mpp_get_data_domain(domain, isd, ied, jsd, jed)
call mpp_get_global_domain(domain, isg, ieg, jsg, jeg)

! get the grid file to read

if(variable_exists(fileobj, trim(mod_name)//'_mosaic_file' )) then
call read_data(fileobj, trim(mod_name)//'_mosaic_file', solo_mosaic_file)

solo_mosaic_file = 'INPUT/'//trim(solo_mosaic_file)
if(.not. open_file(mosaicfileobj, solo_mosaic_file, 'read')) then
call mpp_error(FATAL, 'data_override_mod(get_grid_version_2: Error in opening solo mosaic file '// &
& trim(solo_mosaic_file))
endif
open_solo_mosaic=.true.
else
mosaicfileobj = fileobj
open_solo_mosaic = .false.
end if

call get_mosaic_tile_grid(grid_file, mosaicfileobj, domain)

if(.not. open_file(tilefileobj, grid_file, 'read')) then
call mpp_error(FATAL, 'data_override_mod(get_grid_version_2: Error in opening tile file '//trim(grid_file))
endif

call get_variable_size(tilefileobj, 'area', siz)
nlon_super = siz(1); nlat_super = siz(2)
if( mod(nlon_super,2) .NE. 0) call mpp_error(FATAL, &
'data_override_mod: '//trim(mod_name)//' supergrid longitude size can not be divided by 2')
if( mod(nlat_super,2) .NE. 0) call mpp_error(FATAL, &
'data_override_mod: '//trim(mod_name)//' supergrid latitude size can not be divided by 2')
nlon = nlon_super/2;
nlat = nlat_super/2;
call check_grid_sizes(trim(mod_name)//'_domain ', domain, nlon, nlat)
isc2 = 2*isc-1; iec2 = 2*iec+1
jsc2 = 2*jsc-1; jec2 = 2*jec+1

start(1) = isc2; nread(1) = iec2-isc2+1
start(2) = jsc2; nread(2) = jec2-jsc2+1

allocate(tmpx(isc2:iec2, jsc2:jec2), tmpy(isc2:iec2, jsc2:jec2) )

call read_data( tilefileobj, 'x', tmpx, corner=start,edge_lengths=nread)
call read_data( tilefileobj, 'y', tmpy, corner=start,edge_lengths=nread)

! copy data onto model grid
if(trim(mod_name) == 'ocn' .OR. trim(mod_name) == 'ice') then
do j = jsc, jec
do i = isc, iec
lon(i,j) = (tmpx(i*2-1,j*2-1)+tmpx(i*2+1,j*2-1)+tmpx(i*2+1,j*2+1)+tmpx(i*2-1,j*2+1))*0.25
lat(i,j) = (tmpy(i*2-1,j*2-1)+tmpy(i*2+1,j*2-1)+tmpy(i*2+1,j*2+1)+tmpy(i*2-1,j*2+1))*0.25
end do
end do
else
do j = jsc, jec
do i = isc, iec
lon(i,j) = tmpx(i*2,j*2)
lat(i,j) = tmpy(i*2,j*2)
end do
end do
endif

! convert to radian
lon = lon * deg_to_radian
lat = lat * deg_to_radian

deallocate(tmpx, tmpy)
min_lon = minval(lon)
max_lon = maxval(lon)
call mpp_min(min_lon)
call mpp_max(max_lon)

call close_file(tilefileobj)
if(open_solo_mosaic) call close_file(mosaicfileobj)

end subroutine get_grid_version_2
#include "get_grid_version_r4.fh"
#include "get_grid_version_r8.fh"

end module get_grid_version_mod
!> @}
Expand Down
Loading
Loading