c----------------------------------------------------------------------------- c c get_att_text_safe.f -- Same as nf_get_att_text, plus length protection. c c 1.00 2009-sep-24 Original version. By Dave Allured. c Adapted from netcdf_fix.f90 v1.00. c Check for output string too short, also Netcdf errors. c Strip null terminator character. c Blank pad on right, prevent right hand garbage chars. c 1.01 2009-sep-29 Use length info for faster padding and scanning. c Add check for string data type. c Add reliable handling for zero length string attribute. c 1.02 2011-jul-18 For "attribute not found" error, must return Netcdf c status back to caller for error handling. c c Output: Function value = Netcdf status code, success or error in one case c string = attribute string value, right padded with blanks c c Error handling: c c This version checks for output string shorter than attribute c string, as well as various Netcdf errors. c c Unusual errors result in an error message and program halt. c As of version 1.02, "attribute not found" error is returned to c caller. c c Notes: c c This is a Netcdf convenience function to read Netcdf string c attributes without having to explicitly check length, allocate c memory, blank pad, and strip a trailing null character each time. c c Fixed length output strings may be used, but they must be long c enough to hold the attribute value. c c The calling sequence is identical to the standard API function c nf_get_att_text. See Netcdf documentation. c c Any single trailing null character, the C string terminator, is c stripped. Nulls are NOT stripped in either of these unusual c cases: c c * There is more than one null character in the original string, c or it is not the last one. This implies a complex, binary c encoded, or malformed string. c c * No null character is present in the original string returned c by nf_get_att_text. c c The return string is padded with right hand blanks if it is c shorter than the attribute string. This prevents right hand c garbage characters that are a problem with some Netcdf versions. c c If you really want to read a Netcdf attribute containing c trailing blanks or nulls, then just use the original c nf_get_att_text function. c c This version is written for all Netcdf 3 and 4 versions that have c a Fortran 77 API, currently 3.5.0 through 4.1.3. c c----------------------------------------------------------------------------- integer function get_att_text_safe (ncid, varid, name, string) implicit none integer ncid ! netcdf file ID integer varid ! netcdf variable ID character(*) name ! specify attribute name character(*) string ! returned string attribute value c Local variables and defs. include 'netcdf.inc' integer lnblnk ! function def. character err_mes*80 ! error message from netcdf integer xtype ! netcdf data type, not used integer attlen ! netcdf attribute length integer status ! netcdf return status integer outlen ! length of caller's return string integer i ! character pointer logical right_to_left ! direction switch for index function c Read length of attribute from Netcdf. status = NF_INQ_ATT (ncid, varid, name, xtype, attlen) if (status .ne. NF_NOERR) then if (status .eq. NF_ENOTATT) then ! if attribute not found... get_att_text_safe = status ! must return this Netcdf error return ! to caller end if err_mes = NF_STRERROR (status) ! handle all other Netcdf errors print *, '*** get_att_text_safe:', & ' Fatal error when checking attribute.' print *, '*** File ID = ', ncid print *, '*** Var ID = ', varid print *, '*** Attribute = ', name(1:lnblnk(name)) print *, '*** Called NF_INQ_ATT, got Netcdf error no. ', status print *, '*** ', err_mes(1:lnblnk(err_mes)) stop 99 end if c Check attribute data type. if (xtype .ne. NF_CHAR) then print *, '*** get_att_text_safe: Fatal:', & ' Attempt to read string from non-string attribute.' print *, '*** File ID = ', ncid print *, '*** Var ID = ', varid print *, '*** Attribute = ', name(1:lnblnk(name)) print *, '*** Att type = ', xtype stop 99 end if c Check for output string too short. outlen = len (string) ! get length of caller's return string if (attlen .gt. outlen) then print *, '*** get_att_text_safe: Fatal:', & ' Attribute is too long for return string.' print *, '*** File ID = ', ncid print *, '*** Var ID = ', varid print *, '*** Attribute = ', name(1:lnblnk(name)) print *, '*** Attribute length = ', attlen print *, '*** Return string length = ', outlen stop 99 end if c Length okay. Pad right side of return string with blanks, if needed. if (outlen .gt. attlen) then ! if return string is longer than att: string(attlen+1:) = ' ' ! pad on right, because nf_get_att_text end if ! leaves uncleared memory! c Now read attribute value into the left side of the string. status = NF_GET_ATT_TEXT (ncid, varid, name, string) ! read attribute ! returns only ATTLEN number of chars. if (status .ne. NF_NOERR) then err_mes = NF_STRERROR (status) print *, '*** get_att_text_safe:', & ' Fatal error when reading attribute.' print *, '*** File ID = ', ncid print *, '*** Var ID = ', varid print *, '*** Attribute = ', name(1:lnblnk(name)) print *, '*** Called NF_GET_ATT_TEXT, got Netcdf error no. ', & status print *, '*** ', err_mes(1:lnblnk(err_mes)) stop 99 end if c Strip single trailing null character, if present. if (attlen .gt. 0) then ! allow for zero length attribute right_to_left = .true. ! search string right to left i = index (string(1:attlen), char(0), right_to_left) ! find *last* null if (i .gt. 0) string(i:i) = ' ' ! if present: overwrite with a space, end if ! add to normal blank padding get_att_text_safe = NF_NOERR ! if we get here, return status=good end function get_att_text_safe