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.

Sign up for GitHub

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

Fixes #1360. Fix NAG build bug #1412

Merged
merged 1 commit into from
Mar 7, 2022
Merged

Fixes #1360. Fix NAG build bug #1412

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0

### Fixed

- Fix build bug with NAG in `cub2latlon_regridder.F90`
- Fixes DO_NOT_CONNECT errors when calling MAPL_TerminateAnyImport
- Fixed the alarms in the couplers to account if they are called before ESMF_ClockAdvance is called
- Reverted generic/VarSpec.F90 to hash b02e8ff (fix for #1410)
Expand Down
82 changes: 42 additions & 40 deletions base/cub2latlon_regridder.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ module SupportMod
type (StringRouteHandleMap) :: route_handles
integer :: srcTerm
type (ESMF_RouteHandle), target :: default_route_handle


type RegridSupport
! Cubed-sphere
Expand All @@ -49,7 +49,7 @@ module SupportMod
type (FileMetadata) :: cfio_cubed_sphere
type (ESMF_Grid) :: grid_cubed_sphere
type (Netcdf4_Fileformatter) :: formatter_cubed_sphere

! Lat-lon
integer :: IM
integer :: JM
Expand All @@ -61,12 +61,12 @@ module SupportMod
type (Netcdf4_Fileformatter) :: formatter_lat_lon
real(kind=ESMF_KIND_R8), allocatable :: longitudes(:)
real(kind=ESMF_KIND_R8), allocatable :: latitudes(:)

! Both
logical :: debug = .false.
integer :: LM
integer :: NT

! Misc
type (StringVector) :: requested_variables
type (StringVector) :: scalar_variables
Expand Down Expand Up @@ -132,18 +132,18 @@ subroutine process_command_line(regridder, rc)
end do

contains

function get_next_argument() result(argument)
character(len=:), allocatable :: argument

integer :: length

i_arg = i_arg + 1

call get_command_argument(i_arg, length=length)
allocate(character(len=length) :: argument)
call get_command_argument(i_arg, value=argument)

end function get_next_argument


Expand Down Expand Up @@ -196,7 +196,7 @@ subroutine transfer_metadata(this)!vars)
call add_global_attributes()
call add_variables()

contains
contains

subroutine add_grid_dimensions()
integer :: status
Expand Down Expand Up @@ -230,7 +230,7 @@ subroutine add_grid_variables()
!call tmp%add_attribute('units', Attribute('degrees_north'))
call tmp%add_attribute('units', 'degrees_north')
call ll%add_variable('lat', tmp, rc=status)

tmp = Variable(type=pFIO_REAL32, dimensions='lon')
!call tmp%add_attribute('long_name', Attribute('longitudes'))
call tmp%add_attribute('long_name', 'longitudes')
Expand Down Expand Up @@ -264,7 +264,7 @@ subroutine add_global_attributes()
attr => iter%value()

call ll%add_attribute(name, attr)

call iter%next()
end do

Expand Down Expand Up @@ -322,7 +322,7 @@ subroutine add_variables()
end if

end select

call var_iter%next()
end do

Expand All @@ -333,7 +333,7 @@ end subroutine add_variables
subroutine transfer_attributes(from, to)
type (Variable), target, intent(in) :: from
type (Variable), target, intent(inout) :: to

type (StringAttributeMap), pointer :: attributes
type (StringAttributeMapIterator) :: attr_iter
character(len=:), pointer :: attr_name
Expand All @@ -346,7 +346,9 @@ subroutine transfer_attributes(from, to)
case ('grid_mapping','coordinates') ! CS specific attributes
! skip
case default
call to%add_attribute(attr_name, attr_iter%value())
associate (val => attr_iter%value())
call to%add_attribute(attr_name, val)
end associate
end select
call attr_iter%next()
end do
Expand Down Expand Up @@ -389,10 +391,10 @@ subroutine categorize(var, var_name, vars, rc)
_ASSERT(north_component /= '','needs informative message')
call this%vector_variables(1)%push_back(var_name)
call this%vector_variables(2)%push_back(north_component)
elseif (index(long_name, 'north') == 0) then !
elseif (index(long_name, 'north') == 0) then !
call this%scalar_variables%push_back(var_name)
end if

end subroutine categorize


Expand Down Expand Up @@ -451,21 +453,21 @@ function find_north_component(vars, long_name, rc) result(north_component)
end if
call var_iter%next()
end do

end function find_north_component

logical function keep_var(var_name, requested_vars)
character(len=*), intent(in) :: var_name
type (StringVector), intent(in) :: requested_vars

integer :: idx

if (requested_vars%size() == 0) then
keep_var = .true.
else
keep_var = (requested_vars%get_index(var_name) /= 0)
end if

end function keep_var


Expand All @@ -479,7 +481,7 @@ function make_dim_string(cs_dims) result(ll_dims)

type (StringVectorIterator) :: dim_iter
character(len=:), pointer :: d

ll_dims = ''
dim_iter = cs_dims%begin()
do while (dim_iter /= cs_dims%end())
Expand All @@ -497,7 +499,7 @@ function make_dim_string(cs_dims) result(ll_dims)
call dim_iter%next()
end do
end function make_dim_string

end subroutine transfer_metadata

function run_length_encode(missing) result(str)
Expand All @@ -512,7 +514,7 @@ function run_length_encode(missing) result(str)
str = ''
return
end if

count = 1
value = missing(1)
str = to_string_bool(value)
Expand Down Expand Up @@ -603,7 +605,7 @@ subroutine regrid(srcField, dstField, missing, rc)
if (any_missing) then
local_key = run_length_encode(reshape(src_array,[size(src_array)]) == missing)
global_key = all_gather(local_key)

handle => route_handles%at(global_key)
if (.not. associated(handle)) then
allocate(handle)
Expand Down Expand Up @@ -641,15 +643,15 @@ subroutine regrid(srcField, dstField, missing, rc)
& zeroregion=ESMF_REGION_SELECT, &
& rc=status)
_VERIFY(status)

_RETURN(_SUCCESS)
else
handle => default_route_handle
end if
else
handle => default_route_handle
end if

call ESMF_FieldRegrid(srcField, dstField, routeHandle=handle, &
& termorderflag=ESMF_TERMORDER_SRCSEQ, rc=status)
_VERIFY(status)
Expand All @@ -664,7 +666,7 @@ end subroutine regrid
subroutine write_data(this, rc)
class (RegridSupport), target, intent(inout) :: this
integer, optional, intent(out) :: rc


type (StringVariableMapIterator) :: var_iter
type (StringVariableMap), pointer :: variables
Expand Down Expand Up @@ -740,7 +742,7 @@ subroutine write_data(this, rc)
allocate(ll_vector_patch(this%i_1:this%i_n, this%j_1:this%j_n,2))
allocate(ll_uvw(this%i_1:this%i_n, this%j_1:this%j_n,3))


allocate(cs_scalar_patch(this%nx_loc,this%ny_loc))
allocate(cs_vector_patch(this%nx_loc,this%ny_loc,2))

Expand Down Expand Up @@ -820,14 +822,14 @@ subroutine write_data(this, rc)

is_scalar = .false.
is_east_vector_component = .false.

do idx = 1, this%scalar_variables%size()
if (this%scalar_variables%at(idx) == var_name) then
is_scalar = .true.
exit
end if
end do

if (.not. is_scalar) then
do idx = 1, this%vector_variables(1)%size()
if (this%vector_variables(1)%at(idx) == var_name) then
Expand All @@ -837,13 +839,13 @@ subroutine write_data(this, rc)
end if
end do
end if

if (.not. (is_scalar .or. is_east_vector_component)) then
call var_iter%next()
cycle
end if


do time = 1, this%nt
do level = 1, num_levels

Expand Down Expand Up @@ -949,7 +951,7 @@ subroutine write_metadata(this, rc)
integer, optional, intent(out) :: rc
type (ESMF_VM) :: vm_global
integer :: status

include 'mpif.h'

!$$ if (local_pet == 0) then
Expand Down Expand Up @@ -977,15 +979,15 @@ elemental function sind(x) result(s)
real(kind=REAL64) :: s

s = sin(x * MAPL_DEGREES_TO_RADIANS_R8)

end function sind

elemental function cosd(x) result(c)
real(kind=REAL64), intent(in) :: x
real(kind=REAL64) :: c

c = cos(x * MAPL_DEGREES_TO_RADIANS_R8)

end function cosd

subroutine create_esmf_grids(this, rc)
Expand Down Expand Up @@ -1027,7 +1029,7 @@ subroutine create_cubed_sphere_grid(this, rc)
nPetPerTile = pet_count/n_tiles
nx = nint(sqrt(float(nPetPerTile*this%Xdim)/this%Xdim))
nx = max(nx,1)
do while( mod(nPetPerTile,nx).NE.0)
do while( mod(nPetPerTile,nx).NE.0)
nx = nx - 1
enddo
ny=nPetPerTile/nx
Expand Down Expand Up @@ -1063,12 +1065,12 @@ subroutine create_cubed_sphere_grid(this, rc)
this%y_1=minIndex(2,local_pet)
this%y_n=maxIndex(2,local_pet)
case(2)
this%x_1=minIndex(1,local_pet) - this%Xdim
this%x_1=minIndex(1,local_pet) - this%Xdim
this%x_n=maxIndex(1,local_pet) - this%Xdim
this%y_1=minIndex(2,local_pet)
this%y_n=maxIndex(2,local_pet)
case(3)
this%x_1=minIndex(1,local_pet) - this%Xdim
this%x_1=minIndex(1,local_pet) - this%Xdim
this%x_n=maxIndex(1,local_pet) - this%Xdim
this%y_1=minIndex(2,local_pet) - this%Xdim
this%y_n=maxIndex(2,local_pet) - this%Xdim
Expand Down Expand Up @@ -1245,7 +1247,7 @@ program main
print*,'num regridders = ', 1 + route_handles%size()

end if

call ESMF_finalize()

contains
Expand Down