GCC Code Coverage Report


Directory: ./
File: misc/nf95_get_att_m.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 34 0.0%
Branches: 0 24 0.0%

Line Branch Exec Source
1 ! $Id$
2 module nf95_get_att_m
3
4 use handle_err_m, only: handle_err
5 use netcdf, only: nf90_get_att, nf90_noerr
6 use simple, only: nf95_inquire_attribute
7
8 implicit none
9
10 interface nf95_get_att
11 module procedure nf95_get_att_text, nf95_get_att_one_FourByteInt
12
13 ! The difference between the specific procedures is the type of
14 ! argument "values".
15 end interface
16
17 private
18 public nf95_get_att
19
20 contains
21
22 subroutine nf95_get_att_text(ncid, varid, name, values, ncerr)
23
24 integer, intent( in) :: ncid, varid
25 character(len = *), intent( in) :: name
26 character(len = *), intent(out) :: values
27 integer, intent(out), optional:: ncerr
28
29 ! Variables local to the procedure:
30 integer ncerr_not_opt
31 integer att_len
32
33 !-------------------
34
35 ! Check that the length of "values" is large enough:
36 call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
37 ncerr=ncerr_not_opt)
38 if (ncerr_not_opt == nf90_noerr) then
39 if (len(values) < att_len) then
40 print *, "nf95_get_att_text"
41 print *, "varid = ", varid
42 print *, "attribute name: ", name
43 print *, 'length of "values" is not large enough'
44 print *, "len(values) = ", len(values)
45 print *, "number of characters in attribute: ", att_len
46 stop 1
47 end if
48 end if
49
50 values = "" ! useless in NetCDF version 3.6.2 or better
51 ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
52 if (present(ncerr)) then
53 ncerr = ncerr_not_opt
54 else
55 call handle_err("nf95_get_att_text " // trim(name), ncerr_not_opt, &
56 ncid, varid)
57 end if
58
59 if (att_len >= 1 .and. ncerr_not_opt == nf90_noerr) then
60 ! Remove null terminator, if any:
61 if (iachar(values(att_len:att_len)) == 0) values(att_len:att_len) = " "
62 end if
63
64 end subroutine nf95_get_att_text
65
66 !***********************
67
68 subroutine nf95_get_att_one_FourByteInt(ncid, varid, name, values, ncerr)
69
70 integer, intent( in) :: ncid, varid
71 character(len = *), intent( in) :: name
72 integer , intent(out) :: values
73 integer, intent(out), optional:: ncerr
74
75 ! Variables local to the procedure:
76 integer ncerr_not_opt
77 integer att_len
78
79 !-------------------
80
81 ! Check that the attribute contains a single value:
82 call nf95_inquire_attribute(ncid, varid, name, nclen=att_len, &
83 ncerr=ncerr_not_opt)
84 if (ncerr_not_opt == nf90_noerr) then
85 if (att_len /= 1) then
86 print *, "nf95_get_att_one_FourByteInt"
87 print *, "varid = ", varid
88 print *, "attribute name: ", name
89 print *, 'the attribute does not contain a single value'
90 print *, "number of values in attribute: ", att_len
91 stop 1
92 end if
93 end if
94
95 ncerr_not_opt = nf90_get_att(ncid, varid, name, values)
96 if (present(ncerr)) then
97 ncerr = ncerr_not_opt
98 else
99 call handle_err("nf95_get_att_one_FourByteInt " // trim(name), &
100 ncerr_not_opt, ncid, varid)
101 end if
102
103 end subroutine nf95_get_att_one_FourByteInt
104
105 end module nf95_get_att_m
106