* * nco_attr.F * * Ansley Manke * March 1, 2005 * * This function spawns a netCDF edit call, ncatted to edit * an attribute (e.g. new attribute, edit or delete atttibute, * or add lines to the global history attribute) * * * Notes: * 1) our ncatted does not have the i data type. It returns the messages * * > ncatted -O -h -a missing_value,A,o,i,3 x.nc * ncatted: ERROR `i' is not a supported netCDF data type * ncatted: HINT: Valid data types are `c' = char, `f' = float, `d' = double,`s' = short, `l' = long, `b' = byte * 2) errors from ncatted do not stop the function from returning normally. SUBROUTINE nco_attr_init(id) * Define arguments and result INCLUDE 'ferret_cmn/EF_Util.cmn' INTEGER id, arg CALL ef_set_desc(id, . 'Call ncatted to edit attributes in a netCDF file' ) CALL ef_set_num_args(id, 6) CALL ef_set_axis_inheritance(id, ABSTRACT, NORMAL, NORMAL, . NORMAL) CALL ef_set_piecemeal_ok(id, NO, NO, NO, NO) arg = 1 CALL ef_set_arg_name(id, arg, 'FileName') CALL ef_set_arg_desc(id, arg, 'netCDF file name') CALL ef_set_axis_influence(id, arg, NO, NO, NO, NO) CALL ef_set_arg_type(id, arg, STRING_ARG) arg = 2 CALL ef_set_arg_name(id, arg, 'VariableName') CALL ef_set_arg_desc(id, arg, 'Variable name (or global)') CALL ef_set_axis_influence(id, arg, NO, NO, NO, NO) CALL ef_set_arg_type(id, arg, STRING_ARG) arg = 3 CALL ef_set_arg_name(id, arg, 'AttributeName') CALL ef_set_arg_desc(id, arg, 'Attribute to change') CALL ef_set_axis_influence(id, arg, NO, NO, NO, NO) CALL ef_set_arg_type(id, arg, STRING_ARG) arg = 4 CALL ef_set_arg_name(id, arg, 'AttType') CALL ef_set_arg_desc(id, arg, 'Attribute type') CALL ef_set_axis_influence(id, arg, NO, NO, NO, NO) CALL ef_set_arg_type(id, arg, STRING_ARG) arg = 5 CALL ef_set_arg_name(id, arg, 'Mode') CALL ef_set_arg_desc(id, arg, 'o=edit, a=append, d=delete') CALL ef_set_axis_influence(id, arg, NO, NO, NO, NO) CALL ef_set_arg_type(id, arg, STRING_ARG) arg = 6 CALL ef_set_arg_name(id, arg, 'AttributeValue') CALL ef_set_arg_desc(id, arg, 'new value of attribute') CALL ef_set_axis_influence(id, arg, NO, NO, NO, NO) CALL ef_set_arg_type(id, arg, STRING_ARG) RETURN END * Define abstract output axis: 1 value SUBROUTINE nco_attr_result_limits(id) INCLUDE 'ferret_cmn/EF_Util.cmn' INTEGER id INTEGER ivalue ivalue = 1 CALL ef_set_axis_limits(id, X_AXIS, ivalue, ivalue) RETURN END * * Compute the result * SUBROUTINE nco_attr_compute(id, arg_1, arg_2, arg_3, arg_4, . arg_5, arg_6, result) INCLUDE 'ferret_cmn/EF_Util.cmn' INCLUDE 'ferret_cmn/EF_mem_subsc.cmn' INTEGER id REAL bad_flag(1:EF_MAX_ARGS), bad_flag_result REAL arg_1(mem1lox:mem1hix, mem1loy:mem1hiy, . mem1loz:mem1hiz, mem1lot:mem1hit) REAL arg_2(mem2lox:mem2hix, mem2loy:mem2hiy, mem2loz:mem2hiz, . mem2lot:mem2hit) REAL arg_3(mem3lox:mem3hix, mem3loy:mem3hiy, mem3loz:mem3hiz, . mem3lot:mem3hit) REAL arg_4(mem4lox:mem4hix, mem4loy:mem4hiy, mem4loz:mem4hiz, . mem4lot:mem4hit) REAL arg_5(mem5lox:mem5hix, mem5loy:mem5hiy, mem5loz:mem5hiz, . mem5lot:mem5hit) REAL arg_6(mem6lox:mem6hix, mem6loy:mem6hiy, mem6loz:mem6hiz, . mem6lot:mem6hit) REAL result(memreslox:memreshix, memresloy:memreshiy, . memresloz:memreshiz, memreslot:memreshit) INTEGER res_lo_ss(4), res_hi_ss(4), res_incr(4) INTEGER STRINGLEN, arg, blen, slen REAL attval, val REAL*8 dattval INTEGER*2 isattval INTEGER iattval CHARACTER*1 battval CHARACTER*1 mode, atttype CHARACTER*3 atttype_in CHARACTER*1024 filename, attributevalue CHARACTER*254 variablename, attributename, errmsg CHARACTER*2048 buff CALL ef_get_res_subscripts(id, res_lo_ss, res_hi_ss, res_incr) CALL ef_get_bad_flags(id, bad_flag, bad_flag_result) arg = 1 CALL ef_get_arg_string(id, arg, filename) arg = 2 CALL ef_get_arg_string(id, arg, variablename) arg = 3 CALL ef_get_arg_string(id, arg, attributename) arg = 4 CALL ef_get_arg_string(id, arg, atttype_in) arg = 5 CALL ef_get_arg_string(id, arg, mode) arg = 6 CALL ef_get_arg_string(id, arg, attributevalue) IF (STRINGLEN(atttype_in) .GT. 1) THEN CALL EF_BAIL_OUT(id, . 'Attribute type must be f, d, i, l, s, c, or b') ELSE atttype = atttype_in(1:1) ENDIF IF (atttype .EQ. 'i' .OR. atttype .EQ. 'l' .OR. . atttype .EQ. 'I' .OR. atttype .EQ. 'L') atttype = 'l' * Check for valid values of mode IF (mode .EQ. 'o' .OR. mode .EQ. 'O') THEN mode = 'o' ELSE IF (mode .EQ. 'a' .OR. mode .EQ. 'A') THEN mode = 'a' ELSE IF (mode .EQ. 'd' .OR. mode .EQ. 'D') THEN mode = 'd' ELSE CALL EF_BAIL_OUT(id, 'Mode must be o, a, or d') ENDIF * Build the string for the ncatted command * ncatted -O -h att_nm,var_nm,mode,att_type,att_val filename * Mode will always be o for overwrite buff = 'ncatted -O -h -a ' blen = 17 slen = STRINGLEN(attributename) buff = buff(1:blen)//attributename(1:slen)//',' blen = blen + slen + 1 slen = STRINGLEN(variablename) buff = buff(1:blen)//variablename(1:slen)//','//mode(1:1)//',' blen = blen + slen + 3 slen = STRINGLEN(atttype) buff = buff(1:blen)//atttype(1:slen)//',' blen = blen + slen + 1 ! ncatted -O -h -a cartesian_axis,LAT,o,c,"Z" x.nc * Read the attribute value based on its type. * See documentation at the end of this file for attribute types. IF (atttype .EQ. 'f' .OR. atttype .EQ. 'F') THEN READ (attributevalue,*,err=501) attval slen = STRINGLEN(attributevalue) buff = buff(1:blen)//attributevalue(1:slen) blen = blen + slen ELSE IF (atttype .EQ. 'd' .OR. atttype .EQ. 'D') THEN READ (attributevalue,*,err=502) dattval slen = STRINGLEN(attributevalue) buff = buff(1:blen)//attributevalue(1:slen) blen = blen + slen ELSE IF (atttype .EQ. 'i' .OR. atttype .EQ. 'l' .OR. . atttype .EQ. 'I' .OR. atttype .EQ. 'L') THEN READ (attributevalue,*,err=503) iattval READ (attributevalue,*,err=503) attval val = iattval IF (val .NE. attval) GOTO 503 slen = STRINGLEN(attributevalue) buff = buff(1:blen)//attributevalue(1:slen) blen = blen + slen ELSE IF (atttype .EQ. 's' .OR. atttype .EQ. 'S') THEN READ (attributevalue,*,err=504) isattval WRITE (attributevalue,*) isattval slen = STRINGLEN(attributevalue) buff = buff(1:blen)//attributevalue(1:slen) blen = blen + slen ELSE IF (atttype .EQ. 'c' .OR. atttype .EQ. 'C') THEN slen = STRINGLEN(attributevalue) buff = buff(1:blen)//'"'//attributevalue(1:slen)//'"' blen = blen + slen + 3 ELSE IF (atttype .EQ. 'b' .OR. atttype .EQ. 'B') THEN READ (attributevalue,*,err=505) battval slen = STRINGLEN(attributevalue) buff = buff(1:blen)//attributevalue(1:slen) blen = blen + slen ELSE CALL EF_BAIL_OUT(id, . 'Attribute type must be f, d, i, s, c, or b') ENDIF * Append the file name slen = STRINGLEN(filename) buff = buff(1:blen)//' '//filename(1:slen) blen = blen + slen + 1 * Spawn the command result(res_lo_ss(X_AXIS), res_lo_ss(Y_AXIS), res_lo_ss(Z_AXIS), . res_lo_ss(T_AXIS)) = bad_flag_result CALL system( buff(1:blen) ) result(res_lo_ss(X_AXIS), res_lo_ss(Y_AXIS), res_lo_ss(Z_AXIS), . res_lo_ss(T_AXIS)) = 1 RETURN 501 slen = STRINGLEN(attributevalue) errmsg = 'Error reading attribute value as floating-point ' . //attributevalue(1:slen) CALL EF_BAIL_OUT(id, errmsg) 502 slen = STRINGLEN(attributevalue) errmsg = 'Error reading attribute value as double-precision ' . //attributevalue(1:slen) CALL EF_BAIL_OUT(id, errmsg) 503 slen = STRINGLEN(attributevalue) errmsg = 'Error reading attribute value as an integer ' . //attributevalue(1:slen) CALL EF_BAIL_OUT(id, errmsg) 504 slen = STRINGLEN(attributevalue) errmsg = 'Error reading attribute value as a short integer ' . //attributevalue(1:slen) CALL EF_BAIL_OUT(id, errmsg) 505 slen = STRINGLEN(attributevalue) errmsg = 'Error reading attribute value as a byte ' . //attributevalue(1:slen) CALL EF_BAIL_OUT(id, errmsg) END * ncatted documentation: here are the attribute types * f Float. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_FLOAT. * d Double. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_DOUBLE. * i Integer. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_INT. * l Long. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_LONG. * s Short. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_SHORT. * c Char. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_CHAR. * b Byte. Value(s) specified in att_val will be stored as netCDF intrinsic type NC_BYTE. * * 3.1 netCDF external data types * * The external types supported by the netCDF interface are: * * char 8-bit characters intended for representing text. * byte 8-bit signed or unsigned integers (see discussion below). * short 16-bit signed integers. * int 32-bit signed integers. * float real 32-bit IEEE floating-point. * double 64-bit IEEE floating-point. INTEGER FUNCTION STRINGLEN (strin) * determine the length of a character string as the position of the last * non-blank character * from tm_lenstr (use tm_lenstr if this is ever converted to an * internally-linked function) * calling argument declarations: CHARACTER*(*) strin * internal variable declarations: INTEGER mright, i * initialize: find highest possible right hand limit of string mright = LEN(strin) DO 100 i = mright,1,-1 IF (strin(i:i) .NE. ' ') GOTO 200 100 CONTINUE * for all blanks STRINGLEN = 0 * Found non-blank 200 STRINGLEN = i RETURN END