Skip to content

Commit

Permalink
Minor updates and additions.
Browse files Browse the repository at this point in the history
  • Loading branch information
@interkosmos
interkosmos committed Mar 6, 2024
1 parent ace147a commit 2e550b1
Show file tree
Hide file tree
Showing 7 changed files with 464 additions and 74 deletions.
1 change: 0 additions & 1 deletion .github/workflows/build.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@ jobs:
matrix:
os: [ ubuntu-22.04 ]
env:
DM_PIPE_SKIP: 1
GCC_V: 13
NO_COLOR: 1

Expand Down
423 changes: 375 additions & 48 deletions src/dm_geocom.f90
View file

Large diffs are not rendered by default.

4 changes: 2 additions & 2 deletions src/dm_geocom_api.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -494,7 +494,7 @@ pure subroutine dm_geocom_api_request_delete(request, device_type, file_type, da
!! or more files.
!!
!! Wildcards may be used to delete multiple files. If the deletion date
!! is valid, only files older than the deletion date are deleted.
!! is valid, only files older than the date are deleted.
!!
!! The instrument returns the following responses:
!!
Expand Down Expand Up @@ -608,7 +608,7 @@ pure subroutine dm_geocom_api_request_download(request, block_number)
character(len=*), parameter :: REQUEST_NAME = 'download'
character(len=*), parameter :: REQUEST_PATTERN = "(?<grc>\d+),'(?<blockval>[0-9a-f]+)',(?<blocklen>\d+)"
integer, parameter :: REQUEST_CODE = 23304
integer, parameter :: MODE = REQUEST_MODE_GEOCOM_FILE
integer, parameter :: MODE = REQUEST_MODE_GEOCOM_FILE

type(request_type), intent(out) :: request !! Prepared request.
integer, intent(in) :: block_number !! Block number.
Expand Down
16 changes: 16 additions & 0 deletions src/dm_geocom_error.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -288,6 +288,8 @@ module dm_geocom_error

! Public procedures.
public :: dm_geocom_error_message
public :: dm_geocom_is_error
public :: dm_geocom_is_ok
contains
! **************************************************************************
! PUBLIC PROCEDURES.
Expand Down Expand Up @@ -834,4 +836,18 @@ pure function dm_geocom_error_message(code) result(str)
str = 'unknown GeoCOM code'
end select
end function dm_geocom_error_message

pure elemental logical function dm_geocom_is_error(grc) result(is_error)
!! Returns `.true.` if given GeoCOM code is an error.
integer, intent(in) :: grc !! GeoCOM code.

is_error = (grc /= GRC_OK)
end function dm_geocom_is_error

pure elemental logical function dm_geocom_is_ok(grc) result(is_ok)
!! Returns `.true.` if given GeoCOM code is not an error.
integer, intent(in) :: grc !! GeoCOM code.

is_ok = (grc == GRC_OK)
end function dm_geocom_is_ok
end module dm_geocom_error
87 changes: 64 additions & 23 deletions src/dm_request.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ module dm_request

interface dm_request_get
!! Generic function to get value, unit, type, and error of a response.
module procedure :: request_get_byte
module procedure :: request_get_i4
module procedure :: request_get_i8
module procedure :: request_get_l
Expand Down Expand Up @@ -284,6 +285,56 @@ end subroutine dm_request_out
! **************************************************************************
! PRIVATE PROCEDURES.
! **************************************************************************
pure elemental subroutine request_get_byte(request, name, value, unit, type, error, status)
!! Returns byte response as single character value, unit, type, and error
!! of response of name `name`.
!!
!! The routine returns the following error codes in `status`:
!!
!! * `E_EMPTY` if the request has no responses.
!! * `E_NOT_FOUND` if a response of the given name does not exist.
!! * `E_TYPE` if the response value is not of type logical.
!!
!! On error, `value` will not be modified.
integer, parameter :: VALUE_TYPE = RESPONSE_TYPE_BYTE

type(request_type), intent(inout) :: request !! Request type.
character(len=*), intent(in) :: name !! Response name.
character, intent(inout) :: value !! Response value.
character(len=RESPONSE_UNIT_LEN), intent(out), optional :: unit !! Response unit.
integer, intent(out), optional :: type !! Response value type.
integer, intent(out), optional :: error !! Response error.
integer, intent(out), optional :: status !! Error code.

integer :: i, rc

response_block: block
rc = E_EMPTY
if (request%nresponses == 0) exit response_block

rc = E_NOT_FOUND
i = dm_request_index(request, name)
if (i == 0) exit response_block

rc = E_TYPE
if (request%responses(i)%type /= VALUE_TYPE) exit response_block

rc = E_NONE
value = achar(floor(request%responses(i)%value, kind=i4))

if (present(unit)) unit = request%responses(i)%unit
if (present(type)) type = request%responses(i)%type
if (present(error)) error = request%responses(i)%error
end block response_block

if (present(status)) status = rc
if (rc == E_NONE) return

if (present(unit)) unit = ' '
if (present(type)) type = VALUE_TYPE
if (present(error)) error = E_NONE
end subroutine request_get_byte

pure elemental subroutine request_get_i4(request, name, value, unit, type, error, status)
!! Returns 4-byte integer response value, unit, type, and error of
!! response of name `name`.
Expand All @@ -294,21 +345,19 @@ pure elemental subroutine request_get_i4(request, name, value, unit, type, error
!! * `E_NOT_FOUND` if a response of the given name does not exist.
!! * `E_TYPE` if the response value is not of type logical.
!!
!! If no response is found, `value` will be set to `huge(0_i4)`.
!! On error, `value` will not be modified.
integer, parameter :: VALUE_TYPE = RESPONSE_TYPE_INT32

type(request_type), intent(inout) :: request !! Request type.
character(len=*), intent(in) :: name !! Response name.
integer(kind=i4), intent(out) :: value !! Response value.
integer(kind=i4), intent(inout) :: value !! Response value.
character(len=RESPONSE_UNIT_LEN), intent(out), optional :: unit !! Response unit.
integer, intent(out), optional :: type !! Response value type.
integer, intent(out), optional :: error !! Response error.
integer, intent(out), optional :: status !! Error code.

integer :: i, rc

value = huge(0_i4)

response_block: block
rc = E_EMPTY
if (request%nresponses == 0) exit response_block
Expand All @@ -321,7 +370,7 @@ pure elemental subroutine request_get_i4(request, name, value, unit, type, error
if (request%responses(i)%type /= VALUE_TYPE) exit response_block

rc = E_NONE
value = int(request%responses(i)%value, kind=i4)
value = floor(request%responses(i)%value, kind=i4)

if (present(unit)) unit = request%responses(i)%unit
if (present(type)) type = request%responses(i)%type
Expand All @@ -346,21 +395,19 @@ pure elemental subroutine request_get_i8(request, name, value, unit, type, error
!! * `E_NOT_FOUND` if a response of the given name does not exist.
!! * `E_TYPE` if the response value is not of type logical.
!!
!! If no response is found, `value` will be set to `huge(0_i8)`.
!! On error, `value` will not be modified.
integer, parameter :: VALUE_TYPE = RESPONSE_TYPE_INT64

type(request_type), intent(inout) :: request !! Request type.
character(len=*), intent(in) :: name !! Response name.
integer(kind=i8), intent(out) :: value !! Response value.
integer(kind=i8), intent(inout) :: value !! Response value.
character(len=RESPONSE_UNIT_LEN), intent(out), optional :: unit !! Response unit.
integer, intent(out), optional :: type !! Response value type.
integer, intent(out), optional :: error !! Response error.
integer, intent(out), optional :: status !! Error code.

integer :: i, rc

value = huge(0_i8)

response_block: block
rc = E_EMPTY
if (request%nresponses == 0) exit response_block
Expand All @@ -373,7 +420,7 @@ pure elemental subroutine request_get_i8(request, name, value, unit, type, error
if (request%responses(i)%type /= VALUE_TYPE) exit response_block

rc = E_NONE
value = int(request%responses(i)%value, kind=i8)
value = floor(request%responses(i)%value, kind=i8)

if (present(unit)) unit = request%responses(i)%unit
if (present(type)) type = request%responses(i)%type
Expand All @@ -398,21 +445,19 @@ pure elemental subroutine request_get_l(request, name, value, unit, type, error,
!! * `E_NOT_FOUND` if a response of the given name does not exist.
!! * `E_TYPE` if the response value is not of type logical.
!!
!! If no response is found, `value` will be set to `.false.`.
!! On error, `value` will not be modified.
integer, parameter :: VALUE_TYPE = RESPONSE_TYPE_LOGICAL

type(request_type), intent(inout) :: request !! Request type.
character(len=*), intent(in) :: name !! Response name.
logical, intent(out) :: value !! Response value.
logical, intent(inout) :: value !! Response value.
character(len=RESPONSE_UNIT_LEN), intent(out), optional :: unit !! Response unit.
integer, intent(out), optional :: type !! Response value type.
integer, intent(out), optional :: error !! Response error.
integer, intent(out), optional :: status !! Error code.

integer :: i, rc

value = .false.

response_block: block
rc = E_EMPTY
if (request%nresponses == 0) exit response_block
Expand All @@ -425,7 +470,7 @@ pure elemental subroutine request_get_l(request, name, value, unit, type, error,
if (request%responses(i)%type /= VALUE_TYPE) exit response_block

rc = E_NONE
value = (int(request%responses(i)%value) >= 1)
value = (floor(request%responses(i)%value) >= 1)

if (present(unit)) unit = request%responses(i)%unit
if (present(type)) type = request%responses(i)%type
Expand All @@ -450,21 +495,19 @@ pure elemental subroutine request_get_r4(request, name, value, unit, type, error
!! * `E_NOT_FOUND` if a response of the given name does not exist.
!! * `E_TYPE` if the response value is not of type logical.
!!
!! If no response is found, `value` will be set to `huge(0.0_r4)`.
!! On error, `value` will not be modified.
integer, parameter :: VALUE_TYPE = RESPONSE_TYPE_REAL32

type(request_type), intent(inout) :: request !! Request type.
character(len=*), intent(in) :: name !! Response name.
real(kind=r4), intent(out) :: value !! Response value.
real(kind=r4), intent(inout) :: value !! Response value.
character(len=RESPONSE_UNIT_LEN), intent(out), optional :: unit !! Response unit.
integer, intent(out), optional :: type !! Response value type.
integer, intent(out), optional :: error !! Response error.
integer, intent(out), optional :: status !! Error code.

integer :: i, rc

value = huge(0.0_r4)

response_block: block
rc = E_EMPTY
if (request%nresponses == 0) exit response_block
Expand Down Expand Up @@ -502,21 +545,19 @@ pure elemental subroutine request_get_r8(request, name, value, unit, type, error
!! * `E_NOT_FOUND` if a response of the given name does not exist.
!! * `E_TYPE` if the response value is not of type logical.
!!
!! If no response is found, `value` will be set to `huge(0.0_r8)`.
!! On error, `value` will not be modified.
integer, parameter :: VALUE_TYPE = RESPONSE_TYPE_REAL64

type(request_type), intent(inout) :: request !! Request type.
character(len=*), intent(in) :: name !! Response name.
real(kind=r8), intent(out) :: value !! Response value.
real(kind=r8), intent(inout) :: value !! Response value.
character(len=RESPONSE_UNIT_LEN), intent(out), optional :: unit !! Response unit.
integer, intent(out), optional :: type !! Response value type.
integer, intent(out), optional :: error !! Response error.
integer, intent(out), optional :: status !! Error code.

integer :: i, rc

value = huge(0.0_r8)

response_block: block
rc = E_EMPTY
if (request%nresponses == 0) exit response_block
Expand Down
1 change: 1 addition & 0 deletions test/dmtestobserv.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,7 @@ logical function test02() result(stat)
if (.not. dm_equals(rval8, 1.0_r8)) return

print *, 'Calling get routine ...'
ival4 = huge(0_i4)
call dm_request_get(request, 'invalid', ival4, status=rc)
if (ival4 /= huge(0_i4)) return
if (rc /= E_NOT_FOUND) return
Expand Down
6 changes: 6 additions & 0 deletions test/dmtestplot.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,12 @@ program dmtestplot
!!
!! This may be necessary on test platforms where Gnuplot or bi-directional
!! pipes are not available.
!!
!! If _gnuplot(1)_ is not available under the name `gnuplot`, set an alias:
!!
!! $ alias gnuplot="gnuplot-nox"
!!
!! Otherwise, the tests in this program will fail.
use :: dmpack
implicit none (type, external)
integer, parameter :: NTESTS = 1
Expand Down

0 comments on commit 2e550b1

Please sign in to comment.