Skip to content

Commit

Permalink
fix select types
Browse files Browse the repository at this point in the history
  • Loading branch information
mcallic2 committed Aug 2, 2023
1 parent 7ec4e5a commit be3fe85
Showing 1 changed file with 17 additions and 14 deletions.
31 changes: 17 additions & 14 deletions astronomy/astronomy.F90
Original file line number Diff line number Diff line change
Expand Up @@ -516,28 +516,31 @@ subroutine astronomy_init (latb, lonb)
!--------------------------------------------------------------------
! check that no invalid types (integers or characters) are given as optional arg

is_valid=.false.
if (present(latb) .and. present(lonb)) then
select type (latb)
type is (real(r4_kind))
select type (lonb)
type is (real(r4_kind))
is_valid = .true.
end select
type is (real(r8_kind))
select type (lonb)
type is (real(r4_kind))
is_valid = .true.
end select
type is (real(r8_kind))
select type (lonb)
type is (real(r8_kind))
is_valid = .true.
end select
end select
end select
jd = size(latb,2) - 1
id = size(lonb,1) - 1
allocate (cosz_ann(id, jd))
allocate (solar_ann(id, jd))
allocate (fracday_ann(id, jd))
total_pts = jd*id
elseif (present(latb) .and. .not. present(lonb)) then
call error_mesg ('astronomy_mod', 'lat and lon must both be present', FATAL)
end if

if(is_valid) then
jd = size(latb,2) - 1
id = size(lonb,1) - 1
allocate (cosz_ann(id, jd))
allocate (solar_ann(id, jd))
allocate (fracday_ann(id, jd))
total_pts = jd*id
else
call error_mesg ('astronomy_mod', 'lat and lon must both be present', FATAL)
endif

!---------------------------------------------------------------------
Expand Down

0 comments on commit be3fe85

Please sign in to comment.