Skip to content

Commit

Permalink
Merge pull request #1412 from GEOS-ESM/hotfix/mathomp4/#1360-fix-nag-…
Browse files Browse the repository at this point in the history 
…failure

Fixes #1360. Fix NAG build bug
  • Loading branch information
@mathomp4
mathomp4 authored Mar 7, 2022
2 parents 40b13dc + 8288ca2 commit f3a3924
Show file tree
Hide file tree
Showing 2 changed files with 43 additions and 40 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
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
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

0 comments on commit f3a3924

Please sign in to comment.