1!------------ Array/string put/get routines for a given varid ---------------- 2 3! Replacement for fort-vario.c 4 5! Written by: Richard Weed, Ph.D. 6! Center For Advanced Vehicular Systems 7! Mississippi State University 8! rweed@cavs.msstate.edu 9 10 11! License (and other Lawyer Language) 12 13! This software is released under the Apache 2.0 Open Source License. The 14! full text of the License can be viewed at : 15! 16! http:www.apache.org/licenses/LICENSE-2.0.html 17! 18! The author grants to the University Corporation for Atmospheric Research 19! (UCAR), Boulder, CO, USA the right to revise and extend the software 20! without restriction. However, the author retains all copyrights and 21! intellectual property rights explicitly stated in or implied by the 22! Apache license 23 24! Version 1.: Sept. 2005 - Initial Cray X1 version 25! Version 2.: May 2006 - Updated to support g95 26! Version 3.: April 2009 - Updated for netCDF 4.0.1 27! Version 4.: April 2010 - Updated for netCDF 4.1.1 28! Added preprocessor tests for int and real types 29! Version 5.: Jan. 2016 - Some minor code cleanup 30 31!--------------------------------- nf_put_var_text ----------------------- 32 Function nf_put_var_text(ncid, varid, text) RESULT(status) 33 34! Write out a character string to dataset 35 36 USE netcdf_nc_interfaces 37 38 Implicit NONE 39 40 Integer, Intent(IN) :: ncid, varid 41 Character(LEN=*), Intent(IN) :: text 42 43 Integer :: status 44 45 Integer(C_INT) :: cncid, cvarid, cstatus 46 47 cncid = ncid 48 cvarid = varid - 1 ! Subtract 1 to get C varid 49 50 cstatus = nc_put_var_text(cncid, cvarid, text) 51 52 status = cstatus 53 54 End Function nf_put_var_text 55!--------------------------------- nf_put_var_text_a ----------------------- 56 Function nf_put_var_text_a(ncid, varid, text) RESULT(status) 57 58! Write out array of characters to dataset 59 60 USE netcdf_nc_interfaces 61 62 Implicit NONE 63 64 Integer, Intent(IN) :: ncid, varid 65 Character(LEN=1), Intent(IN) :: text(*) 66 67 Integer :: status 68 69 Integer(C_INT) :: cncid, cvarid, cstatus 70 71 cncid = ncid 72 cvarid = varid - 1 ! Subtract 1 to get C varid 73 74 cstatus = nc_put_var_text(cncid, cvarid, text) 75 76 status = cstatus 77 78 End Function nf_put_var_text_a 79!--------------------------------- nf_put_var_int1 ------------------------- 80 Function nf_put_var_int1(ncid, varid, i1vals) RESULT(status) 81 82! Write out 8 bit integer array to dataset 83 84 USE netcdf_nc_interfaces 85 86 Implicit NONE 87 88 Integer, Intent(IN) :: ncid, varid 89 Integer(NFINT1), Intent(IN) :: i1vals(*) 90 91 Integer :: status 92 93 Integer(C_INT) :: cncid, cvarid, cstatus 94 95 If (C_SIGNED_CHAR < 0) Then ! schar not supported by processor 96 status = NC_EBADTYPE 97 RETURN 98 EndIf 99 100 cncid = ncid 101 cvarid = varid - 1 ! Subtract 1 to get C varid 102 103#if NF_INT1_IS_C_SIGNED_CHAR 104 cstatus = nc_put_var_schar(cncid, cvarid, i1vals) 105#elif NF_INT1_IS_C_SHORT 106 cstatus = nc_put_var_short(cncid, cvarid, i1vals) 107#elif NF_INT1_IS_C_INT 108 cstatus = nc_put_var_int(cncid, cvarid, i1vals) 109#elif NF_INT1_IS_C_LONG 110 cstatus = nc_put_var_long(cncid, cvarid, i1vals) 111#endif 112 113 status = cstatus 114 115 End Function nf_put_var_int1 116!--------------------------------- nf_put_var_int2 ------------------------- 117 Function nf_put_var_int2(ncid, varid, i2vals) RESULT(status) 118 119! Write out 16 bit integer array to dataset 120 121 USE netcdf_nc_interfaces 122 123 Implicit NONE 124 125 Integer, Intent(IN) :: ncid, varid 126 Integer(NFINT2), Intent(IN) :: i2vals(*) 127 128 Integer :: status 129 130 Integer(C_INT) :: cncid, cvarid, cstatus 131 132 If (C_SHORT < 0) Then ! short not supported by processor 133 status = NC_EBADTYPE 134 RETURN 135 EndIf 136 137 cncid = ncid 138 cvarid = varid - 1 ! Subtract 1 to get C varid 139 140#if NF_INT2_IS_C_SHORT 141 cstatus = nc_put_var_short(cncid, cvarid, i2vals) 142#elif NF_INT2_IS_C_INT 143 cstatus = nc_put_var_int(cncid, cvarid, i2vals) 144#elif NF_INT2_IS_C_LONG 145 cstatus = nc_put_var_long(cncid, cvarid, i2vals) 146#endif 147 148 status = cstatus 149 150 End Function nf_put_var_int2 151!--------------------------------- nf_put_var_int -------------------------- 152 Function nf_put_var_int(ncid, varid, ivals) RESULT(status) 153 154! Write out 32 bit integer array to dataset 155 156 USE netcdf_nc_interfaces 157 158 Implicit NONE 159 160 Integer, Intent(IN) :: ncid, varid 161 Integer(NFINT), Intent(IN) :: ivals(*) 162 163 Integer :: status 164 165 Integer(C_INT) :: cncid, cvarid, cstatus 166 167 cncid = ncid 168 cvarid = varid - 1 ! Subtract 1 to get C varid 169 170#if NF_INT_IS_C_INT 171 cstatus = nc_put_var_int(cncid, cvarid, ivals) 172#elif NF_INT_IS_C_LONG 173 cstatus = nc_put_var_long(cncid, cvarid, ivals) 174#endif 175 176 status = cstatus 177 178 End Function nf_put_var_int 179!--------------------------------- nf_put_var_real ------------------------- 180 Function nf_put_var_real(ncid, varid, rvals) RESULT(status) 181 182! Write out 32 bit real array to dataset 183 184 USE netcdf_nc_interfaces 185 186 Implicit NONE 187 188 Integer, Intent(IN) :: ncid, varid 189 Real(NFREAL), Intent(IN) :: rvals(*) 190 191 Integer :: status 192 193 Integer(C_INT) :: cncid, cvarid, cstatus 194 195 cncid = ncid 196 cvarid = varid - 1 ! Subtract 1 to get C varid 197 198#if NF_REAL_IS_C_DOUBLE 199 cstatus = nc_put_var_double(cncid, cvarid, rvals) 200#else 201 cstatus = nc_put_var_float(cncid, cvarid, rvals) 202#endif 203 204 status = cstatus 205 206 End Function nf_put_var_real 207!--------------------------------- nf_put_var_double ----------------------- 208 Function nf_put_var_double(ncid, varid, dvals) RESULT(status) 209 210! Write out 64 bit real array to dataset 211 212 USE netcdf_nc_interfaces 213 214 Implicit NONE 215 216 Integer, Intent(IN) :: ncid, varid 217 Real(RK8), Intent(IN) :: dvals(*) 218 219 Integer :: status 220 221 Integer(C_INT) :: cncid, cvarid, cstatus 222 223 cncid = ncid 224 cvarid = varid - 1 ! Subtract 1 to get C varid 225 226 cstatus = nc_put_var_double(cncid, cvarid, dvals) 227 228 status = cstatus 229 230 End Function nf_put_var_double 231!--------------------------------- nf_put_var_int64 -------------------------- 232 Function nf_put_var_int64(ncid, varid, ivals) RESULT(status) 233 234! Write out 64 bit integer array to dataset 235 236 USE netcdf_nc_interfaces 237 238 Implicit NONE 239 240 Integer, Intent(IN) :: ncid, varid 241 Integer(IK8), Intent(IN) :: ivals(*) 242 243 Integer :: status 244 245 Integer(C_INT) :: cncid, cvarid, cstatus 246 247 cncid = ncid 248 cvarid = varid - 1 ! Subtract 1 to get C varid 249 250 cstatus = nc_put_var_longlong(cncid, cvarid, ivals) 251 252 status = cstatus 253 254 End Function nf_put_var_int64 255!--------------------------------- nf_get_var_text ----------------------- 256 Function nf_get_var_text(ncid, varid, text) RESULT(status) 257 258! Read in a character string from dataset 259 260 USE netcdf_nc_interfaces 261 262 Implicit NONE 263 264 Integer, Intent(IN) :: ncid, varid 265 Character(LEN=*), Intent(OUT) :: text 266 267 Integer :: status 268 269 Integer(C_INT) :: cncid, cvarid, cstatus 270 271 cncid = ncid 272 cvarid = varid - 1 ! Subtract 1 to get C varid 273 text = REPEAT(" ", LEN(text)) 274 275 cstatus = nc_get_var_text(cncid, cvarid, text) 276 277 status = cstatus 278 279 End Function nf_get_var_text 280!--------------------------------- nf_get_var_text_a ----------------------- 281 Function nf_get_var_text_a(ncid, varid, text) RESULT(status) 282 283! Read in array of characters from dataset 284 285 USE netcdf_nc_interfaces 286 287 Implicit NONE 288 289 Integer, Intent(IN) :: ncid, varid 290 Character(LEN=1), Intent(OUT) :: text(*) 291 292 Integer :: status 293 294 Integer(C_INT) :: cncid, cvarid, cstatus 295 296 cncid = ncid 297 cvarid = varid - 1 ! Subtract 1 to get C varid 298 299 cstatus = nc_get_var_text(cncid, cvarid, text) 300 301 status = cstatus 302 303 End Function nf_get_var_text_a 304!--------------------------------- nf_get_var_int1 ------------------------- 305 Function nf_get_var_int1(ncid, varid, i1vals) RESULT(status) 306 307! Read in 8 bit integer array from dataset 308 309 USE netcdf_nc_interfaces 310 311 Implicit NONE 312 313 Integer, Intent(IN) :: ncid, varid 314 Integer(NFINT1), Intent(OUT) :: i1vals(*) 315 316 Integer :: status 317 318 Integer(C_INT) :: cncid, cvarid, cstatus 319 320 If (C_SIGNED_CHAR < 0) Then ! schar not supported by processor 321 status = NC_EBADTYPE 322 RETURN 323 EndIf 324 325 cncid = ncid 326 cvarid = varid - 1 ! Subtract 1 to get C varid 327 328#if NF_INT1_IS_C_SIGNED_CHAR 329 cstatus = nc_get_var_schar(cncid, cvarid, i1vals) 330#elif NF_INT1_IS_C_SHORT 331 cstatus = nc_get_var_short(cncid, cvarid, i1vals) 332#elif NF_INT1_IS_C_INT 333 cstatus = nc_get_var_int(cncid, cvarid, i1vals) 334#elif NF_INT1_IS_C_LONG 335 cstatus = nc_get_var_long(cncid, cvarid, i1vals) 336#endif 337 338 status = cstatus 339 340 End Function nf_get_var_int1 341!--------------------------------- nf_get_var_int2 ------------------------- 342 Function nf_get_var_int2(ncid, varid, i2vals) RESULT(status) 343 344! Read in 16 bit integer array from dataset 345 346 USE netcdf_nc_interfaces 347 348 Implicit NONE 349 350 Integer, Intent(IN) :: ncid, varid 351 Integer(NFINT2), Intent(OUT) :: i2vals(*) 352 353 Integer :: status 354 355 Integer(C_INT) :: cncid, cvarid, cstatus 356 357 If (C_SHORT < 0) Then ! short not supported by processor 358 status = NC_EBADTYPE 359 RETURN 360 EndIf 361 362 cncid = ncid 363 cvarid = varid - 1 ! Subtract 1 to get C varid 364 365#if NF_INT2_IS_C_SHORT 366 cstatus = nc_get_var_short(cncid, cvarid, i2vals) 367#elif NF_INT2_IS_C_INT 368 cstatus = nc_get_var_int(cncid, cvarid, i2vals) 369#elif NF_INT2_IS_C_LONG 370 cstatus = nc_get_var_long(cncid, cvarid, i2vals) 371#endif 372 373 status = cstatus 374 375 End Function nf_get_var_int2 376!--------------------------------- nf_get_var_int -------------------------- 377 Function nf_get_var_int(ncid, varid, ivals) RESULT(status) 378 379! Read in default integer array from dataset 380 381 USE netcdf_nc_interfaces 382 383 Implicit NONE 384 385 Integer, Intent(IN) :: ncid, varid 386 Integer(NFINT), Intent(OUT) :: ivals(*) 387 388 Integer :: status 389 390 Integer(C_INT) :: cncid, cvarid, cstatus 391 392 cncid = ncid 393 cvarid = varid - 1 ! Subtract 1 to get C varid 394 395#if NF_INT_IS_C_INT 396 cstatus = nc_get_var_int(cncid, cvarid, ivals) 397#elif NF_INT_IS_C_LONG 398 cstatus = nc_get_var_long(cncid, cvarid, ivals) 399#endif 400 401 status = cstatus 402 403 End Function nf_get_var_int 404!--------------------------------- nf_get_var_real ------------------------- 405 Function nf_get_var_real(ncid, varid, rvals) RESULT(status) 406 407! Read in 32 bit real array from dataset 408 409 USE netcdf_nc_interfaces 410 411 Implicit NONE 412 413 Integer, Intent(IN) :: ncid, varid 414 Real(NFREAL), Intent(OUT) :: rvals(*) 415 416 Integer :: status 417 418 Integer(C_INT) :: cncid, cvarid, cstatus 419 420 cncid = ncid 421 cvarid = varid - 1 ! Subtract 1 to get C varid 422 423#if NF_REAL_IS_C_DOUBLE 424 cstatus = nc_get_var_double(cncid, cvarid, rvals) 425#else 426 cstatus = nc_get_var_float(cncid, cvarid, rvals) 427#endif 428 429 status = cstatus 430 431 End Function nf_get_var_real 432!--------------------------------- nf_get_var_double ----------------------- 433 Function nf_get_var_double(ncid, varid, dvals) RESULT(status) 434 435! Read in 64 bit real array from dataset 436 437 USE netcdf_nc_interfaces 438 439 Implicit NONE 440 441 Integer, Intent(IN) :: ncid, varid 442 Real(RK8), Intent(OUT) :: dvals(*) 443 444 Integer :: status 445 446 Integer(C_INT) :: cncid, cvarid, cstatus 447 448 cncid = ncid 449 cvarid = varid - 1 ! Subtract 1 to get C varid 450 451 cstatus = nc_get_var_double(cncid, cvarid, dvals) 452 453 status = cstatus 454 455 End Function nf_get_var_double 456!--------------------------------- nf_get_var_int64 -------------------------- 457 Function nf_get_var_int64(ncid, varid, ivals) RESULT(status) 458 459! Read in 64 bit integer array from dataset 460 461 USE netcdf_nc_interfaces 462 463 Implicit NONE 464 465 Integer, Intent(IN) :: ncid, varid 466 Integer(IK8), Intent(OUT) :: ivals(*) 467 468 Integer :: status 469 470 Integer(C_INT) :: cncid, cvarid, cstatus 471 472 cncid = ncid 473 cvarid = varid - 1 ! Subtract 1 to get C varid 474 475 cstatus = nc_get_var_longlong(cncid, cvarid, ivals) 476 477 status = cstatus 478 479 End Function nf_get_var_int64 480